



		    ascii_value_.alm                09/23/77  1034.5rew 09/22/77  1725.3       98136



"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1972 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************

"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1974 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************


          name      ascii_value_

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"         This data segment contains the system dependent declaration of the ASCII
" characters.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

          segdef    char
          segdef    byte

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

char:
byte:

          segdef    NUL
NUL:      vfd       o9/000              " 000o    0d  00h :: Null

          segdef    SOH
SOH:      vfd       o9/001              " 001o    1d  01h :: Start of Header

          segdef    STX
STX:      vfd       o9/002              " 002o    2d  02h :: Start of Text

          segdef    ETX
ETX:      vfd       o9/003              " 003o    3d  03h :: End of Text

          segdef    EOT
EOT:      vfd       o9/004              " 004o    4d  04h :: End of Transmission

          segdef    ENQ
ENQ:      vfd       o9/005              " 005o    5d  05h :: Enquiry (Who Are You)

          segdef    ACK
ACK:      vfd       o9/006              " 006o    6d  06h :: Acknowledgement

          segdef    BEL
BEL:      vfd       o9/007              " 007o    7d  07h :: Audible signal

          segdef    BS
BS:       vfd       o9/010              " 010o    8d  08h :: Backspace

          segdef    HT
HT:       vfd       o9/011              " 011o    9d  09h :: Horizontal Tabulation

          segdef    NL
NL:       vfd       o9/012              " 012o   10d  0Ah :: New Line

          segdef    VT
VT:       vfd       o9/013              " 013o   11d  0Bh :: Vertical Tabulation

          segdef    NP
NP:       vfd       o9/014              " 014o   12d  0Ch :: New Page

          segdef    RT
          segdef    CR
CR:
RT:       vfd       o9/015              " 015o   13d  0Dh :: Carriage Return

          segdef    SO
SO:       vfd       o9/016              " 016o   14d  0Eh :: Shift Out

          segdef    SI
SI:       vfd       o9/017              " 017o   15d  0Fh :: Shift In

          segdef    DLE
DLE:      vfd       o9/020              " 020o   16d  10h :: Data Link Escape

          segdef    DC1
DC1:      vfd       o9/021              " 021o   17d  11h :: Device Control 1

          segdef    DC2
DC2:      vfd       o9/022              " 022o   18d  12h :: Device Control 2

          segdef    DC3
DC3:      vfd       o9/023              " 023o   19d  13h :: Device Control 3

          segdef    DC4
DC4:      vfd       o9/024              " 024o   20d  14h ::  Device Control 4 (Stop)

          segdef    NAK
NAK:      vfd       o9/025              " 025o   21d  15h :: Negative Acknowledgement

          segdef    SYN
SYN:      vfd       o9/026              " 026o   22d  16h :: Synchronous Idle

          segdef    ETB
ETB:      vfd       o9/027              " 027o   23d  17h :: End of Transmission Block

          segdef    CAN
CAN:      vfd       o9/030              " 030o   24d  18h :: Cancel

          segdef    EM
EM:       vfd       o9/031              " 031o   25d  19h :: End of Medium

          segdef    SUB
SUB:      vfd       o9/032              " 032o   26d  1Ah :: Substitute

          segdef    ESC
ESC:      vfd       o9/033              " 033o   27d  1Bh :: Escape

          segdef    FS
FS:       vfd       o9/034              " 034o   28d  1Ch :: File Separator

          segdef    GS
GS:       vfd       o9/035              " 035o   29d  1Dh :: Group Separator

          segdef    RS
RS:       vfd       o9/036              " 036o   30d  1Eh :: Record Separator

          segdef    US
US:       vfd       o9/037              " 037o   31d  1Fh :: Unit Separator

          segdef    SP
SP:       vfd       o9/040              " 040o   32d  20h :: Space

          vfd       o9/041              " 041o   33d  21h :: !

          vfd       o9/042              " 042o   34d  22h :: "

          vfd       o9/043              " 043o   35d  23h :: #

          vfd       o9/044              " 044o   36d  24h :: $

          vfd       o9/045              " 045o   37d  25h :: %

          vfd       o9/046              " 046o   38d  26h :: &

          vfd       o9/047              " 047o   39d  17h :: '

          vfd       o9/050              " 050o   40d  18h :: (

          vfd       o9/051              " 051o   41d  19h :: )

          vfd       o9/052              " 052o   42d  1Ah :: *

          vfd       o9/053              " 053o   43d  1Bh :: +

          vfd       o9/054              " 054o   44d  1Ch :: ,

          vfd       o9/055              " 055o   45d  1Dh :: -

          vfd       o9/056              " 056o   46d  1Eh :: .

          vfd       o9/057              " 057o   47d  1Fh :: /

          vfd       o9/060              " 060o   48d  20h :: 0

          vfd       o9/061              " 061o   49d  31h :: 1

          vfd       o9/062              " 062o   50d  32h :: 2

          vfd       o9/063              " 063o   51d  33h :: 3

          vfd       o9/064              " 064o   52d  34h :: 4

          vfd       o9/065              " 065o   53d  35h :: 5

          vfd       o9/066              " 066o   54d  36h :: 6

          vfd       o9/067              " 067o   55d  37h :: 7

          vfd       o9/070              " 070o   56d  38h :: 8

          vfd       o9/071              " 071o   57d  39h :: 9

          vfd       o9/072              " 072o   58d  3Ah :: :

          vfd       o9/073              " 073o   59d  3Bh :: ; "(semicolon causes ALM problems)

          vfd       o9/074              " 074o   60d  3Ch :: <

          vfd       o9/075              " 075o   61d  3Dh :: =

          vfd       o9/076              " 076o   62d  3Eh :: >

          vfd       o9/077              " 077o   63d  3Fh :: ?

          vfd       o9/100              " 100o   64d  30h :: @

          vfd       o9/101              " 101o   65d  41h :: A

          vfd       o9/102              " 102o   66d  42h :: B

          vfd       o9/103              " 103o   67d  43h :: C

          vfd       o9/104              " 104o   68d  44h :: D

          vfd       o9/105              " 105o   69d  45h :: E

          vfd       o9/106              " 106o   70d  46h :: F

          vfd       o9/107              " 107o   71d  47h :: G

          vfd       o9/110              " 110o   72d  48h :: H

          vfd       o9/111              " 111o   73d  49h :: I

          vfd       o9/112              " 112o   74d  4Ah :: J

          vfd       o9/113              " 113o   75d  4Bh :: K

          vfd       o9/114              " 114o   76d  4Ch :: L

          vfd       o9/115              " 115o   77d  4Dh :: M

          vfd       o9/116              " 116o   78d  4Eh :: N

          vfd       o9/117              " 117o   79d  4Fh :: O

          vfd       o9/120              " 120o   80d  40h :: P

          vfd       o9/121              " 121o   81d  51h :: Q

          vfd       o9/122              " 122o   82d  52h :: R

          vfd       o9/123              " 123o   83d  53h :: S

          vfd       o9/124              " 124o   84d  54h :: T

          vfd       o9/125              " 125o   85d  55h :: U

          vfd       o9/126              " 126o   86d  56h :: V

          vfd       o9/127              " 127o   87d  57h :: W

          vfd       o9/130              " 130o   88d  58h :: X

          vfd       o9/131              " 131o   89d  59h :: Y

          vfd       o9/132              " 132o   90d  5Ah :: Z

          vfd       o9/133              " 133o   91d  5Bh :: [

          vfd       o9/134              " 134o   92d  5Ch :: 
          vfd       o9/135              " 135o   93d  5Dh :: ]

          vfd       o9/136              " 136o   94d  5Eh :: ^

          vfd       o9/137              " 137o   95d  5Fh :: _

          vfd       o9/140              " 140o   96d  50h :: `

          vfd       o9/141              " 141o   97d  61h :: a

          vfd       o9/142              " 142o   98d  62h :: b

          vfd       o9/143              " 143o   99d  63h :: c

          vfd       o9/144              " 144o  100d  64h :: d

          vfd       o9/145              " 145o  101d  65h :: e

          vfd       o9/146              " 146o  102d  66h :: f

          vfd       o9/147              " 147o  103d  67h :: g

          vfd       o9/150              " 150o  104d  68h :: h

          vfd       o9/151              " 151o  105d  69h :: i

          vfd       o9/152              " 152o  106d  6Ah :: j

          vfd       o9/153              " 153o  107d  6Bh :: k

          vfd       o9/154              " 154o  108d  6Ch :: l

          vfd       o9/155              " 155o  109d  6Dh :: m

          vfd       o9/156              " 156o  110d  6Eh :: n

          vfd       o9/157              " 157o  111d  6Fh :: o

          vfd       o9/160              " 160o  112d  60h :: p

          vfd       o9/161              " 161o  113d  71h :: q

          vfd       o9/162              " 162o  114d  72h :: r

          vfd       o9/163              " 163o  115d  73h :: s

          vfd       o9/164              " 164o  116d  74h :: t

          vfd       o9/165              " 165o  117d  75h :: u

          vfd       o9/166              " 166o  118d  76h :: v

          vfd       o9/167              " 167o  119d  77h :: w

          vfd       o9/170              " 170o  120d  78h :: x

          vfd       o9/171              " 171o  121d  79h :: y

          vfd       o9/172              " 172o  122d  7Ah :: z

          vfd       o9/173              " 173o  123d  7Bh :: {

          vfd       o9/174              " 174o  124d  7Ch :: |

          vfd       o9/175              " 175o  125d  7Dh :: }

          vfd       o9/176              " 176o  126d  7Eh :: ~

          segdef    DEL
DEL:      vfd       o9/177              " 177o  127d  7Fh :: DEL

          end




		    net_alm_.alm                    09/23/77  1034.5rew 09/22/77  1725.3       69075



"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1972 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************

          name      net_alm_

          segdef    copy_chars
          segdef    decode_char_pointer
          segdef    scan_for_char
          segdef    scan_from_char_table
          segdef    translate_chars


" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      net_alm_ -- procedure to contain short assembly language
" routines for use by Network programs.
"
"      Most of these routines exist because the Network requires an
" 8-bit data space for Network characters, and the Multics PL/1
" compiler refuses to properly process these.  (It assumes that
" all characters are in a 7-bit data space, and will create tables
" for only the first 128 characters --  causing garbage
" table entries to be utilized for the other 128 characters.)
" Notice that the entry points provided in this module will
" process all 512 characters allowed in the 9-bit data space.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"         Originally created by D. M. Wells, February, 1975.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

          equ       arg_1,2   " use to pick up first arg
          equ       arg_2,4   " use to pick up second arg
          equ       arg_3,6   " use to pick up third arg
          equ       arg_4,8   " use to pick up fourth arg
          equ       arg_5,10  " use to pick up fifth arg




" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      net_alm_$decode_char_pointer -- procedure to convert a
" character pointer into a word pointer and a character offset.
"
"    call net_alm_$decode_char_pointer (char_ptr, word_ptr, word_offset)
"
" declare net_alm_$decode_char_pointer entry (ptr, ptr, fixed bin (24))
"
" Note that the picking up of the character offset depends on
" the fact that the bit offset should be less than 36 and
" the magical properites of 11.  In particular, notice that
" for characters the bit offset (in octal) will be 000, 011,
" 022, or 033.  Notice also that the octal digit field says
" how many character offsets we are from the beginning of the
" word.  Thus all we need to do is to pick up one of the octal
" digits and stuff that into the character offset field, and
" then set the bit offset field to zero and give that back to
" the caller also.
"

decode_char_pointer:
          eppbb     ap|arg_1,*          " get pointer to char ptr

          ldaq      bb|0                " pick up in AQ the core format of pointer
          anq       =o007000,dl         " mask out all but last octal digit of bit offset field
          qrl       9                   " right justify char offset
          stq       ap|arg_3,*          " and give to user as char offset

          eppbp     bb|0,*              " indirect to load value of desired pointer
          adwpbp    0,du                " make the bit offset zero
          spribp    ap|arg_2,*          " give the user this pointer with bit offset 0

          short_return





" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      net_alm_$scan_from_char_table -- procedure to scan a string
" and return the index (starting from 1) of the first table
" entry which is non-zero.
"
"    index = net_alm_$scan_from_char_table (string_ptr, string_len,
"         table_ptr, value)
"    declare net_alm_$scan_from_char_table entry (ptr, fixed bin (24),
"         ptr, bit (9) aligned) returns (fixed bin (24))
"

scan_from_char_table:
          eppbp     ap|arg_1,*          " let bp point to input string
          eppbp     bp|0,*              " ..

          lda       ap|arg_2,*          " let a hold length of input string

          eppbb     ap|arg_3,*          " let bb point to search table
          eppbb     bb|0,*              " ..

          epplb     ap|arg_4,*          " let lb point to output value location

          tct       (pr,rl),fill(000)
          desc9a    bp|0,al
          arg       bb|0
          arg       lb|0

          ldq       ap|arg_4,*
          lda       =o777000000000
          ansa      ap|arg_4,*          " mask out all but table value

          anq       =o000777777777      " maks value out of location part
          ttf       2,ic
          lcq       1,dl
          adq       1,dl
          stq       ap|arg_5,*          " finally store back the location offset

          short_return





" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"    index = net_alm_$scan_for_char (string_ptr, string_len, char)
"    declare net_alm_$scan_for_char (ptr, fixed bin (24), bit (9) aligned,
"         bit (9) aligned)
"

scan_for_char:
          eppbp     ap|arg_1,*          " let bp point to input string
          eppbp     bp|0,*              " ..

          lda       ap|arg_2,*          " let A hold length of input string

          eppbb     ap|arg_3,*          " let bb point to char to search for
          eppbb     bb|0,*              " ..

          epplb     ap|arg_4,*          " let lb point to output value location

          scm       (pr,rl),(pr),mask(000)
          desc9a    bp|0,al
          desc9a    bb|0
          arg       lb|0

          ldq       ap|arg_4,*          " pick up output value
          ttf       2,ic
          lcq       1,dl
          adq       1,dl
          stq       ap|arg_4,*          " put the adjusted value back

          short_return





" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      net_alm_$translate_chars - procedure to translate one
" character string into another character string as specified
" by a translation table.
"
"    call net_alm_$translate_chars (instr_ptr, outstr_ptr, str_len, table_ptr)
"    declare net_alm_$translate_chars entry (ptr, ptr, fixed bin (24), ptr)
"

translate_chars:
          eppbp     ap|arg_1,*          " let bp point to input string
          eppbp     bp|0,*              " ..

          eppbb     ap|arg_2,*          " let bb point to output string
          eppbb     bb|0,*              " ..

          lda       ap|arg_3,*          " let A hold length of string to translate

          epplb     ap|arg_4,*          " let lb point to translation table
          epplb     lb|0,*              " ..

          mvt       (pr,rl),(pr,rl),fill(000)
          desc9a    bp|0,al
          desc9a    bb|0,al
          arg       lb|0

          short_return





" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      net_alm_$copy_chars - procedure to copy characters
" from one location to another.
"
"    call net_alm_$copy_chars (instr_ptr, outstr_ptr, str_len)
"    declare net_alm_$copy_chars entry (ptr, ptr, fixed bin (24))
"

copy_chars:
          eppbp     ap|arg_1,*          " let bp point to origin string
          eppbp     bp|0,*              " ..

          eppbb     ap|arg_2,*          " let bb point to target string
          eppbb     bb|0,*              " ..

          lda       ap|arg_3,*          " let A hold length of string to move

          mlr       (pr,rl),(pr,rl),fill(000)
          desc9a    bp|0,al
          desc9a    bb|0,al

          short_return

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

          end




		    net_async_support_.pl1          09/23/77  1034.5rew 09/22/77  1725.3       53406



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_async_support_:
          procedure ();

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_error_code fixed binary (35),
          P_event_channel fixed binary (71),
          P_channel_list_ptr pointer,
          P_ev_msg_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (num_chans fixed binary (17),
          indx fixed binary (24),
          chn_list_ptr pointer)
               automatic;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          magic_pattern bit (36) initial ((6)"101100"b)
               internal static;

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
          1 ev_chn_buffer aligned based,
             2 header like net_buffer_header,
             2 channel (0 : 0 refer (ev_chn_buffer.num_bytes)) fixed binary (71);

     declare
          1 ev_call_msg aligned based,
             2 channel fixed binary (71),
             2 message fixed binary (71),
             2 process_id bit (36) aligned,
             2 origin aligned,
                3 devsignal bit (18) unaligned,
                3 ring fixed binary (17) unaligned,
             2 data_ptr pointer;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
          error_table_$badcall
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          get_process_id_ constant entry () returns (bit (36) aligned),
          hcs_$wakeup constant entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
          ipc_$decl_ev_call_chn constant entry (fixed bin (71), entry, ptr, fixed bin (17), fixed bin (35)),
          ipc_$reset_ev_call_chn constant entry (fixed bin (71), fixed bin (35)),
          net_buffer_man_$allocate_buffer constant entry (fixed bin (24), fixed bin (24), fixed bin (35)) returns (ptr),
          net_buffer_man_$make_larger_buffer constant entry (ptr, fixed bin (35)) returns (ptr);

     declare
          null
               builtin;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_buffer_header_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

setup_event_channel:
          entry (P_channel_list_ptr, P_event_channel, P_error_code);

          if P_channel_list_ptr = null ()
          then do;
               P_channel_list_ptr = net_buffer_man_$allocate_buffer (5, 72, P_error_code);
               if P_error_code ^= 0
               then return;

               P_channel_list_ptr -> ev_chn_buffer.user_data = magic_pattern;
               end;

          call ipc_$decl_ev_call_chn (P_event_channel, event_channel_handler, P_channel_list_ptr, 1, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

event_channel_handler:
          entry (P_ev_msg_ptr);

          call notify_all_channels (P_ev_msg_ptr -> ev_call_msg.data_ptr, (0));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

notify_all_channels:
          entry (P_channel_list_ptr, P_error_code);

          P_error_code = 0;

          chn_list_ptr = P_channel_list_ptr;

          if chn_list_ptr = null ()
          then return;

          if chn_list_ptr -> ev_chn_buffer.user_data ^= magic_pattern
          then do;
               P_error_code = error_table_$badcall;
               return;
               end;

          do indx = 1 by 1 to chn_list_ptr -> ev_chn_buffer.num_bytes;
               call hcs_$wakeup (get_process_id_ (), chn_list_ptr -> ev_chn_buffer.channel (indx), 0, (0));
               end;

          chn_list_ptr -> ev_chn_buffer.num_bytes = 0;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

insert_in_channel_list:
          entry (P_channel_list_ptr, P_event_channel, P_error_code);

          P_error_code = 0;

          if P_channel_list_ptr = null ()
          then do;
               call setup_event_channel (P_channel_list_ptr, P_event_channel, P_error_code);
               if P_error_code ^= 0
               then return;
               end;

          chn_list_ptr = P_channel_list_ptr;

          if chn_list_ptr -> ev_chn_buffer.user_data ^= magic_pattern
          then do;
               P_error_code = error_table_$badcall;
               return;
               end;

          do indx = 1 by 1 to chn_list_ptr -> ev_chn_buffer.num_bytes;
               if P_event_channel = chn_list_ptr -> ev_chn_buffer.channel (indx)
               then return;                                 /* already in the list, dont add                  */
               end;

          if chn_list_ptr -> ev_chn_buffer.num_bytes > chn_list_ptr -> ev_chn_buffer.buffer_bound
          then do;
               P_channel_list_ptr = net_buffer_man_$make_larger_buffer (P_channel_list_ptr, P_error_code);
               if P_error_code ^= 0
               then return;

               chn_list_ptr = P_channel_list_ptr;           /* get copy of channel list ptr again             */
               end;

          chn_list_ptr -> ev_chn_buffer.num_bytes = chn_list_ptr -> ev_chn_buffer.num_bytes + 1;
          chn_list_ptr -> ev_chn_buffer.channel (chn_list_ptr -> ev_chn_buffer.num_bytes) = P_event_channel;

          return;

          /* end net_async_support_                        */
end;




		    net_buffer_man_.pl1             09/23/77  1034.5rew 09/22/77  1725.3       84681



net_buffer_man_:
          procedure ();

/*             "net_buffer_man_" -- procedure to provide standard     */
/*        interface for buffer management used within the Network     */
/*        IOSIMs.                                                     */
/*             The buffers managed by this routine must have the      */
/*        same header structure as described in the include file      */
/*        net_buffer_header_dcls.incl.pl1, but they need not have     */
/*        have been allocated by this routine.  Thus, if this routine */
/*        is called upon to free a buffer which has the allocation    */
/*        pointer null, then it will simply unlock the buffer and     */
/*        otherwise leave it alone.                                   */

/*        Originally created by D. M. Wells, February, 1975.          */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_buff_count fixed binary (24),                   /* size (in bytes) of desired buffer              */
          P_byte_size fixed binary (24),                    /* size (in bits) of bytesize of new buffer       */
          P_error_code fixed binary (35),                   /* standard Multics error code                    */
          P_buff_ptr pointer)                               /* pointer to a buffer                            */
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (allocation_size fixed binary (24),
          byte_size fixed binary (24),
          free_space fixed binary (24),
          (old_buffer_size, old_byte_offset, old_num_bytes) fixed binary (24),
          length_to_copy fixed binary (24),
          (buff_ptr, new_buff_ptr, old_buff_ptr) pointer)
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
          area_ptr pointer initial (null ())
               internal static;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          lock_id bit (36) aligned initial ((6)"000111"b)
               internal static;

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_copy_string bit (length_to_copy),
          based_area area)
               based;

     declare
          1 buffer aligned based,                           /* the actual buffer as allocated                 */
             2 header like net_buffer_header,               /* all the header info -- how much, how many, ... */
             2 workspace aligned,
                3 byte (0 : allocation_size refer (buffer.header.buffer_bound)) bit (byte_size) unaligned;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$area_too_small,
          error_table_$badcall)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          get_system_free_area_ constant entry () returns (ptr);

     declare
          (addr, null, stac)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          area condition,
          buffer_format_error_ condition;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_buffer_header_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

allocate_buffer:
          entry (P_buff_count, P_byte_size, P_error_code) returns (ptr);

          P_error_code = 0;

          byte_size = P_byte_size;
          allocation_size = P_buff_count - 1;

          if area_ptr = null ()
          then area_ptr = get_system_free_area_ ();

          on area
               goto allocate_failed;

          allocate buffer in (area_ptr -> based_area) set (new_buff_ptr);

          revert area;

          new_buff_ptr -> buffer.header.allocation_ptr = area_ptr;
          new_buff_ptr -> buffer.header.user_data = ""b;
          new_buff_ptr -> buffer.header.user_info_ptr = null ();

          new_buff_ptr -> buffer.header.workspace_byte_size = byte_size;
          new_buff_ptr -> buffer.header.num_bytes = 0;
          new_buff_ptr -> buffer.header.byte_offset = 0;

          new_buff_ptr -> buffer.header.lock = lock_id;

          return (new_buff_ptr);

                    /* * * * * * * * * * * * * * * * * * * */

allocate_failed:
          P_error_code = error_table_$area_too_small;

          return (null ());

          /* * * * * * * * * * * * * * * * * * * * * * * * */

free_buffer:
          entry (P_buff_ptr, P_error_code);

          P_error_code = 0;

          old_buff_ptr = P_buff_ptr;
          if old_buff_ptr = null ()
          then return;

	if old_buff_ptr -> buffer.header.lock ^= lock_id
	then signal buffer_format_error_;

          P_buff_ptr = null ();

          old_buff_ptr -> buffer.header.lock = ""b;

          if old_buff_ptr -> buffer.allocation_ptr ^= null ()
          then free old_buff_ptr -> buffer in (old_buff_ptr -> buffer.allocation_ptr -> based_area);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

try_initial_buffer:
          entry (P_buff_ptr, P_error_code) returns (ptr);

          P_error_code = 0;

          old_buff_ptr = P_buff_ptr;

          if stac (addr (old_buff_ptr -> buffer.header.lock), lock_id)
          then do;
	     old_buff_ptr -> buffer.header.user_data = ""b;
	     old_buff_ptr -> buffer.header.user_info_ptr = null ();
               old_buff_ptr -> buffer.header.num_bytes = 0;
               old_buff_ptr -> buffer.header.byte_offset = 0;
               return (old_buff_ptr);
               end;

          allocation_size = old_buff_ptr -> buffer.header.buffer_bound + 1;
          byte_size = old_buff_ptr -> buffer.header.workspace_byte_size;

          return (allocate_buffer (allocation_size, byte_size, P_error_code));

          /* * * * * * * * * * * * * * * * * * * * * * * * */

make_larger_buffer:
          entry (P_buff_ptr, P_error_code) returns (ptr);

          P_error_code = 0;

          old_buff_ptr = P_buff_ptr;

          if old_buff_ptr = null ()
          then return (allocate_buffer (256, 9, P_error_code));

	if old_buff_ptr -> buffer.header.lock ^= lock_id
	then signal buffer_format_error_;

          byte_size = old_buff_ptr -> buffer.header.workspace_byte_size;
          old_buffer_size = old_buff_ptr -> buffer.header.buffer_bound + 1;
          old_byte_offset = old_buff_ptr -> buffer.header.byte_offset;
          old_num_bytes = old_buff_ptr -> buffer.header.num_bytes;

          if (old_byte_offset < 0)
                    | (old_byte_offset > old_buffer_size - 1)
                    | (old_num_bytes < 0)
                    | (old_num_bytes + old_byte_offset > old_buffer_size)
          then do;
	     signal buffer_format_error_;
               P_error_code = error_table_$badcall;
               return (old_buff_ptr);
               end;

          new_buff_ptr = allocate_buffer (2 * old_buffer_size, byte_size, P_error_code);
          if P_error_code ^= 0
          then return (old_buff_ptr);

          length_to_copy = old_num_bytes * byte_size;

          addr (new_buff_ptr -> buffer.workspace) -> based_copy_string
                    = addr (old_buff_ptr -> buffer.workspace.byte (old_byte_offset)) -> based_copy_string;

          new_buff_ptr -> buffer.header.lock = old_buff_ptr -> buffer.header.lock;
          new_buff_ptr -> buffer.header.user_data = old_buff_ptr -> buffer.header.user_data;
          new_buff_ptr -> buffer.header.user_info_ptr = old_buff_ptr -> buffer.header.user_info_ptr;
          new_buff_ptr -> buffer.header.num_bytes = old_num_bytes;
          new_buff_ptr -> buffer.header.byte_offset = 0;
          P_buff_ptr = null ();

          call free_buffer (old_buff_ptr, (0));

          return (new_buff_ptr);

          /* * * * * * * * * * * * * * * * * * * * * * * * */

empty_space:
          entry (P_buff_ptr, P_error_code) returns (fixed bin (24));

          P_error_code = 0;

          buff_ptr = P_buff_ptr;

	if buff_ptr -> buffer.header.lock ^= lock_id
	then signal buffer_format_error_;

          free_space = buff_ptr -> buffer.header.buffer_bound + 1;    /* how much space in total buffer       */
          free_space = free_space - buff_ptr -> buffer.header.byte_offset;      /* unused beginning           */
          free_space = free_space - buff_ptr -> buffer.header.num_bytes;        /* valid bytes in middle      */

	if free_space < 0
	then signal buffer_format_error_;

          return (free_space);

          /* * * * * * * * * * * * * * * * * * * * * * * * */

initialize_buffer:
          entry (P_buff_ptr, P_buff_count, P_byte_size, P_error_code);

          P_error_code = 0;

          new_buff_ptr = P_buff_ptr;

          new_buff_ptr -> buffer.header.allocation_ptr = null ();
          new_buff_ptr -> buffer.header.lock = ""b;
          new_buff_ptr -> buffer.header.user_data = ""b;
          new_buff_ptr -> buffer.header.user_info_ptr = null ();

          new_buff_ptr -> buffer.header.workspace_byte_size = P_byte_size;
          new_buff_ptr -> buffer.header.buffer_bound = P_buff_count - 1;
          new_buff_ptr -> buffer.header.num_bytes = 0;
          new_buff_ptr -> buffer.header.byte_offset = 0;

          return;

          /* end net_buffer_man_                           */
end;




		    net_character_io_.pl1           09/23/77  1034.5rew 09/22/77  1725.3      268803



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_character_io_:
          procedure (P_SDB_ptr);

/*             "net_character_io_" -- this is the module of the user process    */
/*        character IOSIM that performs the actual I/O.                         */

/*        Last modified by:                                                     */
/*                  D. M. Wells (1975, November) -- created                     */


          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_nelem fixed binary (24),                        /* num of elements requested to be transmitted    */
          P_nelemt fixed binary (24),                       /* num of elements actually transmitted           */
          P_error_code fixed binary (35),
          P_event_channel fixed binary (71),
          P_delim_set bit (36),                             /* delimiter set identifier prev gotten by caller */
          P_SDB_ptr pointer,                                /* pointer to the SDB for this attachment         */
          P_wksp_ptr pointer)                               /* pointer to input workspace                     */
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (state fixed binary (6),
          (next_output, num_output, xnt) fixed binary (24),
          wksp_offset fixed binary (24),
          delimiter_set_id bit (36),
          err_code fixed binary (35),
          (delimiter_buffer_ptr, wksp_ptr) pointer,
          transfer_proc variable entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)))
               automatic;

     declare
          SDB_ptr pointer initial (P_SDB_ptr)
               automatic;

          /* * * * * DEFINED REFERENCES  * * * * * * * * * */

     declare
          1 SDB aligned like SDB_template defined (SDB_ptr -> SDB_template);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
          1 based_workspace aligned based,
             2 byte (0 : 1) bit (9) unaligned;

     declare
          1 char_buffer aligned based,
             2 header like net_buffer_header,
             2 workspace aligned,
                3 byte (0 : 0 refer (char_buffer.header.buffer_bound)) bit (9) unaligned;

     declare
          1 byte_buffer aligned based,
             2 header like net_buffer_header,
             2 workspace aligned,
                3 byte (0 : 0 refer (byte_buffer.header.buffer_bound)) bit (9 refer (byte_buffer.header.workspace_byte_size)) unaligned;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          disable_mask bit (36) aligned initial (""b)
               internal static options (constant);

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
          net_character_tables_$NL_delim_id
               bit (36) external static;

     declare
         (error_table_$area_too_small,
          error_table_$bad_mode,
          error_table_$device_active,
          error_table_$end_of_info,
          error_table_$invalid_read,
          error_table_$invalid_write,
          error_table_$long_record,
          error_table_$net_invalid_state)                   /* means we got a bad state from hardcore NCP     */
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          hcs_$set_ips_mask constant entry (bit (36) aligned, bit (36) aligned),
          net_$ncp_read constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35)),
          net_$ncp_write constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35)),
          net_alm_$copy_chars constant entry (ptr, ptr, fixed bin (24)),
          net_alm_$decode_char_pointer constant entry (ptr, ptr, fixed bin (24)),
          net_alm_$scan_from_char_table constant entry (ptr, fixed bin (24), ptr, bit (9) aligned) returns (fixed bin (24)),
          net_async_support_$insert_in_channel_list constant entry (ptr, fixed bin (71), fixed bin (35)),
          net_async_support_$notify_all_channels constant entry (ptr, fixed bin (35)),
          net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)),
          net_buffer_man_$make_larger_buffer constant entry (ptr, fixed bin (35)) returns (ptr),
          net_buffer_man_$try_initial_buffer constant entry (ptr, fixed bin (35)) returns (ptr),
          net_convert_size_$ascii_8_to_9 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)),
          net_convert_size_$ascii_9_to_8 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)),
          net_convert_size_$direct_8_to_9 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)),
          net_convert_size_$direct_9_to_8 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)),
          net_convert_size_$telnet_8_to_9 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)),
          net_convert_size_$telnet_9_to_8 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35));

     declare
          (addr, baseptr, dimension, min, null, pointer, substr)
               builtin;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_character_sdb_dcls;
          % include net_buffer_header_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

nc_put_chars_raw:
          entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_error_code);

          P_error_code = 0;
          P_nelemt = 0;

          call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset);

          call write_to_ncp (P_error_code);                 /* push anything in buffer to NCP, if possible    */
          if P_error_code ^= 0
          then return;

          next_output = wksp_offset;
          num_output = P_nelem;

          do while (num_output > 0);
               call move_to_net_buffer (wksp_ptr, next_output, num_output, xnt, net_convert_size_$direct_9_to_8, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               next_output = next_output + xnt;
               num_output = num_output - xnt;
               P_nelemt = P_nelem - num_output;

               call write_to_ncp (P_error_code);
               if P_error_code ^= 0
               then return;

               end;

          P_nelemt = P_nelem;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_async_put_chars:                                         /* entry to write on typewriter                   */
          entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_event_channel, P_error_code);

          P_error_code = 0;
          P_nelemt = 0;                                     /* init num elems trans to zero                   */

          if SDB.w_ncp_idx = ""b
          then do;
               P_error_code = error_table_$invalid_write;
               return;
               end;

          call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset);

          call write_to_ncp (P_error_code);                 /* attempt to flush any data to NCP               */
          if P_error_code ^= 0
          then return;

                                                  /*      Now that we know that we are really going to        */
                                                  /* attempt to send data (incl zero chars), we will not      */
                                                  /* start processing until the NCP has accepted all chars    */
                                                  /* that we have previously attempted to write to it.        */

          if SDB.output_ptr ^= null ()
          then do;                                          /* something is buffered, we wont start just yet  */
               call reset_write_wakeups (P_nelemt);         /* we have finished an operation, fixup ev chns   */
               return;
               end;

          if SDB.current_modes.telnet
          then transfer_proc = net_convert_size_$telnet_9_to_8;
          else if SDB.current_modes.ascii
               then transfer_proc = net_convert_size_$ascii_9_to_8;
               else if SDB.current_modes.direct
                    then transfer_proc = net_convert_size_$direct_9_to_8;
                    else do;
                         P_error_code = error_table_$bad_mode;
                         return;
                         end;

          next_output = wksp_offset;
          num_output = P_nelem;

          do while (num_output > 0);
               call move_to_net_buffer (wksp_ptr, next_output, num_output, xnt, transfer_proc, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               next_output = next_output + xnt;
               num_output = num_output - xnt;
               P_nelemt = next_output - wksp_offset;

               call write_to_ncp (P_error_code);
               if P_error_code ^= 0
               then return;

               if SDB.output_ptr ^= null ()
               then do;                                /* NCP has filled up, return to caller            */
                    call reset_write_wakeups (0);                /* fixup ev chns for async operation    */

                    P_error_code = error_table_$device_active;
                    return;
                    end;
               end;

          call reset_write_wakeups (P_nelemt);

          return;


          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_async_get_to_delim:                                      /* entry to read to a delimiter in input stream   */
          entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_delim_set, P_event_channel, P_error_code);

          P_error_code = 0;
          P_nelemt = 0;                                     /* initialize elements transferred to zero        */

          if SDB.r_ncp_idx = ""b
          then do;
               P_error_code = error_table_$invalid_read;
               return;
               end;

          err_code = 0;

          call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset);

          delimiter_set_id = P_delim_set;
          if substr (delimiter_set_id, 1, 18) = ""b
          then delimiter_buffer_ptr = pointer (addr (net_character_tables_$NL_delim_id), substr (delimiter_set_id, 19, 18));
          else delimiter_buffer_ptr = pointer (baseptr (substr (delimiter_set_id, 1, 18)), substr (delimiter_set_id, 19, 18));

          call read_from_network (wksp_ptr, wksp_offset, P_nelem, P_nelemt, err_code);

          call reset_read_wakeups (P_nelemt);               /* we have finished an operation, fixup ev chns   */

          P_error_code = err_code;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_async_get_chars:                                         /* entry to read from typewriter                  */
          entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_event_channel, P_error_code);

          P_error_code = 0;                                 /* initialize status code to zero                 */

          P_nelemt = 0;                                     /* preset num elements trans to zero              */

          if SDB.r_ncp_idx = ""b
          then do;
               P_error_code = error_table_$invalid_read;
               return;
               end;

          call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset);

          err_code = 0;
          delimiter_buffer_ptr = null ();

          call read_from_network (wksp_ptr, wksp_offset, P_nelem, P_nelemt, err_code);

          call reset_read_wakeups (P_nelemt);               /* we have finished an operation, fixup ev chns   */

          P_error_code = err_code;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

reset_write_wakeups:
          procedure (P_num_trans);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_num_trans fixed binary (24)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if P_num_trans ^= 0
          then call net_async_support_$notify_all_channels (SDB.write_ev_chn_list_ptr, (0));
          else call net_async_support_$insert_in_channel_list (SDB.write_ev_chn_list_ptr, P_event_channel, (0));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

reset_read_wakeups:
          entry (P_num_trans);

          if P_num_trans ^= 0
          then call net_async_support_$notify_all_channels (SDB.read_ev_chn_list_ptr, (0));
          else call net_async_support_$insert_in_channel_list (SDB.read_ev_chn_list_ptr, P_event_channel, (0));

          return;

end;      /* end reset_write_wakeups                       */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

move_to_net_buffer:
          procedure (P_buff_ptr, P_first_offset, P_num_elements, P_num_elements_proc, P_transfer_proc, P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         ((P_first_offset, P_num_elements, P_num_elements_proc) fixed binary (24),
          P_err_code fixed binary (35),
          P_buff_ptr pointer,
          P_transfer_proc variable entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((next_free_loc, num_transmitted) fixed binary (24),
          (num_in_proc, num_out_proc) fixed binary (24),
          (first_to_send, last_to_send, next_to_send) fixed binary (24),
          err_code fixed binary (35),
          continue_to_process bit (1),
          previous_mask bit (36) aligned,
          buffer_ptr pointer,
          out_ptr pointer)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_err_code = 0;
          P_num_elements_proc = 0;

          if P_num_elements = 0
          then return;

          err_code = 0;

          first_to_send = P_first_offset;
          last_to_send = first_to_send + min (P_num_elements, 1000) - 1;
          buffer_ptr = P_buff_ptr;

          call hcs_$set_ips_mask (disable_mask, previous_mask);

          if SDB.output_ptr = null ()
          then do;
               SDB.output_ptr = net_buffer_man_$try_initial_buffer (addr (SDB.initial_output_buffer), P_err_code);
               if P_err_code ^= 0
               then do;
                    call hcs_$set_ips_mask (previous_mask, (""b));
                    return;
                    end;
               end;

          num_transmitted = 0;

          next_to_send = first_to_send;
          continue_to_process = "1"b;
          do while ((next_to_send <= last_to_send) & continue_to_process);
               out_ptr = SDB.output_ptr;

               next_free_loc = out_ptr -> char_buffer.byte_offset + out_ptr -> char_buffer.num_bytes;

               call P_transfer_proc (null (), buffer_ptr, next_to_send, last_to_send - next_to_send + 1, num_in_proc,
                         addr (out_ptr -> char_buffer.workspace), next_free_loc, out_ptr -> char_buffer.buffer_bound - next_free_loc + 1, num_out_proc,
                         err_code);
               next_to_send = next_to_send + num_in_proc;

               num_transmitted = num_transmitted + num_in_proc;
               out_ptr -> char_buffer.num_bytes = out_ptr -> char_buffer.num_bytes + num_out_proc;

               if next_to_send <= last_to_send
               then do;
                    if (P_num_elements < 1000)
                    then do;
                         SDB.output_ptr = net_buffer_man_$make_larger_buffer (SDB.output_ptr, P_err_code);
                         call hcs_$set_ips_mask (previous_mask, (""b));
                         P_num_elements_proc = num_transmitted;
                         return;
                         end;
                    else continue_to_process = "0"b;
                    end;
               end;

          call hcs_$set_ips_mask (previous_mask, (""b));

          P_num_elements_proc = num_transmitted;

          P_err_code = err_code;

          return;

end;      /* end move_to_net_buffer                        */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

write_to_ncp:
          procedure (P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (num_transmitted fixed binary (24),
          err_code fixed binary (35),
          previous_mask bit (36) aligned,
          data_ptr pointer)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_err_code = 0;

          if SDB.output_ptr = null ()
          then return;

          err_code = 0;

          call hcs_$set_ips_mask (disable_mask, previous_mask);

          data_ptr = addr (SDB.output_ptr -> byte_buffer.byte (SDB.output_ptr -> byte_buffer.byte_offset));

          call net_$ncp_write (SDB.w_ncp_idx, data_ptr, SDB.output_ptr -> byte_buffer.num_bytes, num_transmitted, state, err_code);
          SDB.output_ptr -> byte_buffer.byte_offset = SDB.output_ptr -> byte_buffer.byte_offset + num_transmitted;
          SDB.output_ptr -> byte_buffer.num_bytes = SDB.output_ptr -> byte_buffer.num_bytes - num_transmitted;

          if SDB.output_ptr -> byte_buffer.num_bytes = 0
          then do;
               call net_buffer_man_$free_buffer (SDB.output_ptr, (0));
               SDB.output_ptr = null ();
               end;

          call hcs_$set_ips_mask (previous_mask, ((36)"0"b));

          P_err_code = err_code;

          return;

end;      /* end write_to_ncp                              */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

read_from_network:
          procedure (P_buffer_ptr, P_first_offset, P_num_elements, P_num_elements_trans, P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         ((P_first_offset, P_num_elements, P_num_elements_trans) fixed binary (24),
          P_err_code fixed binary (35),
          P_buffer_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((first_offset, num_to_read) fixed binary (24),
          (delim_table_ptr, wksp_ptr) pointer)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_err_code = 0;

          wksp_ptr = P_buffer_ptr;

          P_num_elements_trans = 0;
          do while (P_num_elements_trans = 0);
               if SDB.input_ptr ^= null ()
               then do;
                    if move_input_to_callers (P_err_code)
                    then return;
                    end;

               wksp_ptr = P_buffer_ptr;
               first_offset = P_first_offset;
               num_to_read = P_num_elements;

               if SDB.input_ptr = null ()
               then do;
                    SDB.input_ptr = net_buffer_man_$try_initial_buffer (addr (SDB.initial_input_buffer), P_err_code);
                    if P_err_code ^= 0
                    then return;
                    end;

               if move_input_to_callers (P_err_code)
               then return;

               if ^ read_from_ncp (P_err_code)
               then do;
                    if P_err_code = 0
                    then return;                            /* everything ok, just no data to read            */

                    if P_err_code ^= error_table_$end_of_info
                    then return;                            /* something wrong with this connection           */

                                                            /* otherwise, connection has been closed, and we  */
                                                            /* need to make sure that we get all the data out */

                    delimiter_buffer_ptr = null ();
                    if move_input_to_callers (P_err_code)
                    then;

                    if P_err_code ^= 0
                    then return;                            /* somekind of errors, probably long_record       */

                    P_err_code = error_table_$end_of_info;  /* all done, no more data, and stream was closed  */
                    return;
                    end;
               end;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

                                                  /*      This string returns true if it has moved all the    */
                                                  /* characters to the caller's buffer that it can.  It       */
                                                  /* can't move any more if it finds a delimiter, runs out    */
                                                  /* of caller buffer space, gets a null ptr, etc.            */

move_input_to_callers:
          procedure (p_err_code) returns (bit (1));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          p_err_code fixed binary (35)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((n8, num_elements) fixed binary (24),
          buff_ptr pointer)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          p_err_code = 0;

          buff_ptr = SDB.input_ptr;
          if buff_ptr = null ()
          then n8 = 0;
          else n8 = buff_ptr -> char_buffer.num_bytes;

          if n8 = 0
          then return ("0"b);                               /* there are no characters to move                */

          if delimiter_buffer_ptr = null ()
          then delim_table_ptr = null ();
          else delim_table_ptr = addr (delimiter_buffer_ptr -> char_buffer.workspace);

          if delim_table_ptr = null ()
          then num_elements = min (buff_ptr -> char_buffer.num_bytes, P_num_elements);
          else do;
               n8 = net_alm_$scan_from_char_table (addr (buff_ptr -> char_buffer.byte (buff_ptr -> char_buffer.byte_offset)),
                         buff_ptr -> char_buffer.num_bytes, delim_table_ptr, (""b));

               if n8 = 0
               then return ("0"b);                          /* there are characters, but none is a delimiter  */

               if n8 <= P_num_elements
               then num_elements = n8;
               else do;
                    num_elements = P_num_elements;
                    p_err_code = error_table_$long_record;
                    end;
               end;

          call net_alm_$copy_chars (addr (buff_ptr -> char_buffer.byte (buff_ptr -> char_buffer.byte_offset)),
                    addr (wksp_ptr -> based_workspace.byte (P_first_offset)), num_elements);

          buff_ptr -> char_buffer.num_bytes = buff_ptr -> char_buffer.num_bytes - num_elements;
          buff_ptr -> char_buffer.byte_offset = buff_ptr -> char_buffer.byte_offset + num_elements;

          if buff_ptr -> char_buffer.num_bytes = 0
          then do;
               call net_buffer_man_$free_buffer (SDB.input_ptr, (0));
               SDB.input_ptr = null ();
               end;

          P_num_elements_trans = num_elements;

          return ("1"b);                                    /* we moved all we could (even if 0)              */

end;      /* end move_input_to_callers                    */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

end;      /* end read_from_network                         */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

read_from_ncp:
          procedure (P_err_code) returns (bit (1));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((first_offset, num_elements, num_trans) fixed binary (24),
          (num_in_proc, num_out_proc) fixed binary (24),
          input_buffer (0 : 1099) bit (8),
          got_any_data_this_call bit (1),
          connection_closed bit (1),
          previous_mask bit (36) aligned,
          raw_buffer_ptr pointer,
          transfer_proc variable entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24),
                    ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          connection_closed = "0"b;

          if SDB.current_modes.telnet
          then transfer_proc = net_convert_size_$telnet_8_to_9;
          else if SDB.current_modes.ascii
               then transfer_proc = net_convert_size_$ascii_8_to_9;
               else if SDB.current_modes.direct
                    then transfer_proc = net_convert_size_$direct_8_to_9;
                    else do;
                         P_err_code = error_table_$bad_mode;
                         return ("0"b);
                         end;

          call hcs_$set_ips_mask (disable_mask, previous_mask);

          if SDB.input_ptr = null ()
          then do;
               SDB.input_ptr = net_buffer_man_$try_initial_buffer (addr (SDB.initial_input_buffer), (0));
/* should check error code */
               end;
          else if SDB.input_ptr -> char_buffer.num_bytes = 0
               then SDB.input_ptr -> char_buffer.byte_offset = 0;

          got_any_data_this_call = "0"b;                    /* we haven't read any data yet in the subr call  */
          num_trans = 1;                                    /* lie about num read, so next test will work     */
          do while (num_trans > 0);                         /* keep reading from NCP until dont get any data  */
               num_elements = 0;
               do while (num_elements < dimension (input_buffer, 1));
                    raw_buffer_ptr = SDB.input_ptr;
                    num_elements = raw_buffer_ptr -> char_buffer.buffer_bound
                              - (raw_buffer_ptr -> char_buffer.byte_offset + raw_buffer_ptr -> char_buffer.num_bytes);

                    if num_elements < dimension (input_buffer, 1)
                    then SDB.input_ptr = net_buffer_man_$make_larger_buffer (SDB.input_ptr, (0));
                    end;

               call net_$ncp_read (SDB.r_ncp_idx, addr (input_buffer), dimension (input_buffer, 1),
                         num_trans, state, P_err_code);
               if state ^= 6 & state ^= 11
               then do;                                     /* the network connection has been closed         */
                    connection_closed = "1"b;
                    if (state = 1) & (P_err_code = error_table_$net_invalid_state)
                    then P_err_code = 0;
                    end;

               if num_trans ^= 0
               then do;
                    got_any_data_this_call = "1"b;          /* we have read some data this call               */

                    raw_buffer_ptr = SDB.input_ptr;
                    first_offset = raw_buffer_ptr -> char_buffer.byte_offset + raw_buffer_ptr -> char_buffer.num_bytes;

                    call transfer_proc (null (), addr (input_buffer), 0, num_trans, num_in_proc,
                              addr (raw_buffer_ptr -> char_buffer.byte), first_offset, raw_buffer_ptr -> char_buffer.buffer_bound - first_offset + 1, num_out_proc, (0));
                    first_offset = first_offset + num_out_proc;

                    raw_buffer_ptr -> char_buffer.num_bytes = raw_buffer_ptr -> char_buffer.num_bytes + num_out_proc;
                    end;
               end;

          call hcs_$set_ips_mask (previous_mask, ((36)"0"b));

          if P_err_code ^= 0
          then if P_err_code = error_table_$area_too_small
               then P_err_code = 0;

          if ^ got_any_data_this_call
          then if connection_closed
               then if P_err_code = 0
                    then P_err_code = error_table_$end_of_info;

          return (got_any_data_this_call);

end;      /* end read_from_ncp                             */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


          /* end net_character_io_                           */
end;




		    net_character_iox_.pl1          09/23/77  1034.5rew 09/22/77  1725.3      191655



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_character_iox_:
          procedure (P_IOCB_ptr);

/*	     "net_character_iox_" -- I/O switch interface to the Network TELNET	*/
/*        IOSIMS for pseudo-TTYs and for random Network character connections.  */

/*        Originally coded by D. M. Wells March 6, 1975.                        */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_positioning_type fixed binary (1),              /* type of positioning to do on stream            */
          P_open_mode fixed binary (17),                    /* mode of opening to stream                      */
          P_position_movement fixed binary (24),            /* amount to move current position                */
          P_num_elem fixed binary (24),                     /* max number of elements to be transmitted       */
          P_num_elem_trans fixed binary (24),               /* actual number of elements transmitted          */
          P_extend_bit bit (1) aligned,                     /* on if we are to append to end of previous      */
          P_report_sw bit (1) aligned,                      /* on if we should use com_err_ to report errors  */
          P_error_code fixed binary (35),                   /* standard Multics error code                    */
          (P_new_modes, P_old_modes) character (*),         /* arguments to modes entry point                 */
          P_request character (*),                          /* request being made of control entry point      */
          P_attach_args (*) character (*) varying,          /* arguments to attach call                       */
          P_buffer_ptr pointer,                             /* pointer to workspace buffer                    */
          P_info_ptr pointer,                               /* pointer to data for control entry point        */
          P_IOCB_ptr pointer)                               /* pointer to IOCB associated with switch         */
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (num_read fixed binary (24),
          (num_to_trans, num_trans) fixed binary (24),
          lines fixed binary (24),
          data_in_dim_buffer bit (1),
          temp_buffer character (64),
          buff_ptr pointer,
          SDB_ptr pointer,
          temp_iocb_ptr pointer)
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
          area_ptr pointer initial (null ())
               internal static;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
         (STREAM_INPUT_MODE             initial (1),
          STREAM_OUTPUT_MODE            initial (2),
          STREAM_INPUT_OUTPUT_MODE      initial (3))
               fixed binary (17) internal static;

          /* * * * * DEFINED REFERENCES  * * * * * * * * * */

     declare
          1 IOCB aligned like iocb_template defined (P_IOCB_ptr -> iocb_template.actual_iocb_ptr -> iocb_template);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_char_array (0 : 1048575) character (1),
          based_area area)
               based;

     declare
          1 iox_info aligned based,
             2 CDB_ptr pointer,
	   2 open_ev_chn fixed binary (71),
	   2 read_ev_chn fixed binary (71),
	   2 write_ev_chn fixed binary (71),
             2 open_mode fixed binary (17),
             2 flags unaligned,
                3 asynchronous_open bit (1),
                3 padd bit (35);

     declare
          1 workspace unaligned based,
             2 byte (0 : 1) character (1) unaligned;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
          ascii_value_$NL
               character (1) external static;

     declare
          net_character_tables_$NL_delim_id bit (36)
               external static;

     declare
         (error_table_$device_active,
          error_table_$ionmat,
          error_table_$no_operation,
          error_table_$not_detached,
          error_table_$undefined_order_request)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          get_system_free_area_ constant entry () returns (ptr),
          iox_$err_not_attached constant entry options (variable),
          iox_$err_not_closed constant entry options (variable),
          iox_$err_not_open constant entry options (variable),
          iox_$propagate constant entry (ptr),
          ipc_$block constant entry (ptr, ptr, fixed bin (35)),
          ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          net_character_io_$nc_async_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)),
          net_character_io_$nc_async_get_to_delim constant entry (ptr, ptr, fixed bin (24), fixed bin (24), bit (36), fixed bin (71), fixed bin (35)),
          net_character_io_$nc_async_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24),
                    fixed bin (71), fixed bin (35)),
          net_character_io_util_$nc_reset_readahead constant entry (ptr, fixed bin (35)),
          net_character_io_util_$nc_reset_writebehind constant entry (ptr, fixed bin (35)),
          net_character_xtach_$nc_control constant entry (ptr, char (*), ptr, fixed bin (35)),
          net_character_xtach_$nc_modes constant entry (ptr, char (*), char (*), fixed bin (35)),
          net_character_xtach_$net_character_ constant entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)),
          net_character_xtach_$nc_async_close constant entry (ptr, ptr, fixed bin (71), fixed bin (35)),
          net_character_xtach_$nc_async_open constant entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)),
          net_character_xtach_$nc_detach constant entry (ptr, ptr, fixed bin (35));

     declare
          (addr, length, null, size, substr)
               builtin;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_event_template;
          % include net_iocb_template_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

return_to_caller:
          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_character_attach:
          entry (P_IOCB_ptr, P_attach_args, P_report_sw, P_error_code);

          P_error_code = 0;                                 /* setup for a successful return                  */

          call attach (net_character_xtach_$net_character_, na_iox_open);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_detach:
          entry (P_IOCB_ptr, P_error_code);

          P_error_code = 0;

          call detach ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_open:
          entry (P_IOCB_ptr, P_open_mode, P_extend_bit, P_error_code);

          P_error_code = 0;

          call open (net_character_xtach_$nc_async_open, na_iox_close, P_open_mode);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_close:
          entry (P_IOCB_ptr, P_error_code);

          P_error_code = 0;

          call close (net_character_xtach_$nc_async_close, na_iox_open);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_get_line:
          entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, P_error_code);

          P_num_elem_trans = 0;
          do while (P_num_elem_trans = 0);
               call net_character_io_$nc_async_get_to_delim (IOCB.attach_data_ptr -> iox_info.CDB_ptr,
                              P_buffer_ptr, P_num_elem, P_num_elem_trans, net_character_tables_$NL_delim_id,
                    IOCB.attach_data_ptr -> iox_info.read_ev_chn, P_error_code);
               if P_error_code ^= 0
               then return;

               if P_num_elem_trans = 0
               then call block (IOCB.attach_data_ptr -> iox_info.read_ev_chn);
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_get_chars:
          entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, P_error_code);

          P_error_code = 0;
          P_num_elem_trans = 0;

          buff_ptr = P_buffer_ptr;
          num_to_trans = P_num_elem;
          num_trans = 0;

          do while (num_to_trans ^= 0);
               call net_character_io_$nc_async_get_chars (IOCB.attach_data_ptr -> iox_info.CDB_ptr,
                         addr (buff_ptr -> based_char_array (num_trans)), num_to_trans, num_read,
                         IOCB.attach_data_ptr -> iox_info.write_ev_chn, P_error_code);
               num_to_trans = num_to_trans - num_read;
               num_trans = num_trans + num_read;

               P_num_elem_trans = num_trans;
               if P_error_code ^= 0
               then return;

               if num_read = 0
               then call block (IOCB.attach_data_ptr -> iox_info.write_ev_chn);
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_put_chars:
          entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_error_code);

          P_error_code = 0;

          num_to_trans = P_num_elem;
          num_trans = 0;
          data_in_dim_buffer = "0"b;

          do while (num_to_trans > 0 | data_in_dim_buffer);
               call net_character_io_$nc_async_put_chars (IOCB.attach_data_ptr -> iox_info.CDB_ptr,
                         addr (P_buffer_ptr -> workspace.byte (num_trans)), num_to_trans, num_read,
                         IOCB.attach_data_ptr -> iox_info.write_ev_chn, P_error_code);
               num_trans = num_trans + num_read;
               num_to_trans = num_to_trans - num_read;

               if P_error_code ^= 0
               then if P_error_code = error_table_$device_active
                    then data_in_dim_buffer = "1"b;
                    else return;
               else data_in_dim_buffer = "0"b;

               if (num_to_trans > 0) | (data_in_dim_buffer)
               then call block (IOCB.attach_data_ptr -> iox_info.write_ev_chn);
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_control:
          entry (P_IOCB_ptr, P_request, P_info_ptr, P_error_code);

          call check_control (P_error_code);
          if P_error_code ^= error_table_$undefined_order_request
          then return;

          call net_character_xtach_$nc_control (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_request, P_info_ptr, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */


na_iox_position:
          entry (P_IOCB_ptr, P_positioning_type, P_position_movement, P_error_code);

          P_error_code = 0;

          if (P_positioning_type ^= 0) | (P_position_movement < 0)
          then do;
               P_error_code = error_table_$no_operation;
               return;
               end;

          lines = 0;
          do while (lines < P_position_movement);
               call na_iox_get_line (addr (IOCB), addr (temp_buffer), length (temp_buffer), num_read, P_error_code);
               if P_error_code ^= 0
               then return;

               if substr (temp_buffer, num_read, 1) = ascii_value_$NL
               then lines = lines + 1;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

na_iox_modes:
          entry (P_IOCB_ptr, P_new_modes, P_old_modes, P_error_code);

          call net_character_xtach_$nc_modes (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_new_modes, P_old_modes, P_error_code);

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

block:
          procedure (P_event_channel);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_event_channel fixed binary (71)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          err_code fixed binary (35)
               automatic;

     declare
          1 chn_list aligned automatic,
             2 num_chans fixed binary (17),
             2 padding bit (36),
             2 channel (1) fixed binary (71);

     declare
          1 event_message aligned like event_message_template;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          chn_list.num_chans = 1;
          chn_list.channel (1) = P_event_channel;

          call ipc_$block (addr (chn_list), addr (event_message), err_code);
          if err_code ^= 0
          then do;
               if P_event_channel = 0
               then call ipc_$create_ev_chn (P_event_channel, err_code);        /* iosim has switched to      */
                                                                                /* async operation            */

               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    goto return_to_caller;
                    end;
               end;

          return;

end;      /* end block                                     */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

attach:
          procedure (P_attach_proc, P_open_entry);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_opening_mode fixed binary (17),
          P_attach_proc entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)),
          P_close_proc entry (ptr, ptr, fixed bin (71), fixed bin (35)),
          P_open_proc entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)),

          P_close_entry entry (ptr, fixed bin (35)),
          P_open_entry entry (ptr, fixed bin (17), bit (1), fixed bin (35)))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (should_complete_open bit (1),
          open_args (1) character (32) varying)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if area_ptr = null ()
          then area_ptr = get_system_free_area_ ();

          if IOCB.attach_descrip_ptr ^= null ()
          then do;
               P_error_code = error_table_$ionmat;
               return;
               end;

          allocate iox_info in (area_ptr -> based_area) set (IOCB.attach_data_ptr);
          IOCB.attach_data_ptr -> iox_info.CDB_ptr = null ();
	IOCB.attach_data_ptr -> iox_info.open_ev_chn = 0;
	IOCB.attach_data_ptr -> iox_info.read_ev_chn = 0;
	IOCB.attach_data_ptr -> iox_info.write_ev_chn = 0;
          IOCB.attach_data_ptr -> iox_info.open_mode = 0;
          IOCB.attach_data_ptr -> iox_info.asynchronous_open = "0"b;

          call P_attach_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_attach_args, (P_report_sw), IOCB.attach_descrip_ptr, P_error_code);
          if P_error_code ^= 0
          then do;
               free IOCB.attach_data_ptr -> iox_info in (area_ptr -> based_area);
               return;
               end;

          IOCB.control = na_iox_control;
          IOCB.modes = na_iox_modes;
          IOCB.detach_iocb = na_iox_detach;
          IOCB.open = P_open_entry;

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

detach:
          entry ();

          SDB_ptr = IOCB.attach_data_ptr -> iox_info.CDB_ptr;

          call net_character_xtach_$nc_detach (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.attach_descrip_ptr, P_error_code);
          if P_error_code ^= 0
          then return;

          IOCB.attach_descrip_ptr = null ();
          IOCB.attach_data_ptr -> iox_info.CDB_ptr = null ();

          IOCB.detach_iocb = iox_$err_not_attached;
          IOCB.open = iox_$err_not_attached;

          free IOCB.attach_data_ptr -> iox_info in (area_ptr -> based_area);
          IOCB.attach_data_ptr = null ();

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

open:
          entry (P_open_proc, P_close_entry, P_opening_mode);

          SDB_ptr = IOCB.attach_data_ptr -> iox_info.CDB_ptr;

          should_complete_open = ^ IOCB.attach_data_ptr -> iox_info.asynchronous_open;
          IOCB.attach_data_ptr -> iox_info.asynchronous_open = "0"b;

          IOCB.attach_data_ptr -> iox_info.open_mode = P_opening_mode;

          open_args (1) = "";

          P_error_code = -1;
          do while (P_error_code ^= 0);
               call P_open_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.attach_data_ptr -> iox_info.open_mode, open_args, IOCB.open_descrip_ptr,
                         IOCB.attach_data_ptr -> iox_info.open_ev_chn, P_error_code);
               if P_error_code ^= 0
               then do;
                    if P_error_code = error_table_$device_active
                    then do;
                         if should_complete_open
                         then call block (IOCB.attach_data_ptr -> iox_info.open_ev_chn);
                         else do;
                              P_error_code = 0;
                              return;
                              end;
                         end;
                    else return;
                    end;
               end;

          IOCB.close = P_close_entry;
          IOCB.open = iox_$err_not_open;
          IOCB.detach_iocb = iox_$err_not_closed;

          if IOCB.attach_data_ptr -> iox_info.open_mode ^= STREAM_OUTPUT_MODE
          then do;
               IOCB.get_line = na_iox_get_line;
               IOCB.get_chars = na_iox_get_chars;
               IOCB.position = na_iox_position;
               end;
          if IOCB.attach_data_ptr -> iox_info.open_mode ^= STREAM_INPUT_MODE
          then do;
               IOCB.put_chars = na_iox_put_chars;
               end;

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

close:
          entry (P_close_proc, P_open_entry);

          call P_close_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.open_descrip_ptr, 0, P_error_code);

          IOCB.detach_iocb = na_iox_detach;
          IOCB.open = P_open_entry;
          IOCB.close = iox_$err_not_open;
          IOCB.get_line = iox_$err_not_open;
          IOCB.get_chars = iox_$err_not_open;
          IOCB.put_chars = iox_$err_not_open;
          IOCB.position = iox_$err_not_open;

          call iox_$propagate (addr (IOCB));

          IOCB.control = na_iox_control;
          IOCB.modes = na_iox_modes;

          return;

end;      /* end attach                                    */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

check_control:
          procedure (P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_err_code = 0;

/*          if (P_request = "resetread")   */
/*          then do;   */
/*               call net_character_io_util_$nc_reset_readahead (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_err_code);   */
/*               return;   */
/*               end;   */
/*   */
/*          if (P_request = "resetwrite")   */
/*          then do;   */
/*               call net_character_io_util_$nc_reset_writebehind (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_err_code);   */
/*               return;   */
/*               end;   */
/*   */
/*          if (P_request = "abort")   */
/*          then do;   */
/*               call net_character_io_util_$nc_reset_readahead (IOCB.attach_data_ptr -> iox_info.CDB_ptr, (0));   */
/*               call net_character_io_util_$nc_reset_writebehind (IOCB.attach_data_ptr -> iox_info.CDB_ptr, (0));   */
/*               return;   */
/*               end;   */

          if (P_request = "asynchronous_open")
          then do;
               IOCB.attach_data_ptr -> iox_info.asynchronous_open = "1"b;
               return;
               end;

          if (P_request = "complete_open")
          then do;
               call block (IOCB.attach_data_ptr -> iox_info.open_ev_chn);
               call open (net_character_xtach_$nc_async_open, na_iox_close, IOCB.attach_data_ptr -> iox_info.open_mode);
               return;
               end;

          P_err_code = error_table_$undefined_order_request;

          return;

end;      /* end check_control                             */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_character_iox_                         */
end;




		    net_character_tables_.mexp      09/23/77  1034.5rew 09/22/77  1725.3      202347




          name      net_character_tables_

          segdef    all_delim_table
          segdef    nontype6_link_verification
	segdef	NL_break_table
          segdef    NL_delim_id
          segdef    OUR_DM_delim_table

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      "net_character_tables_" -- data module to contain tables and constants
" to be used by the Network net_character_ IOSIM.
"
" Originally created by D. M. Wells, March, 1975.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      Definitions for use in scan table:

          bool      NIL,000             " this char is not of special interest
          bool      HIT,777             " this char is of interest

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

          &macro    action
&(        ife       &x,1
          vfd       9/&iifend
          ine       &x,1
,9/&iifend
&)
          &end


" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"      Because the links in PL/I segments are now type 6 links, we must
" make sure that we have not been Freiburghouse-ized and see that this
" value is non-zero before we can believe that we have in fact found
" valid scan tables and flag arrays when running in debug mode, i.e.,
" usually non-bound.

nontype6_link_verification:
          dec       12345

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

          even

NL_break_table:
                              " see net_buffer_header_dcls.incl.pl1 for
                              " for format of this header
          its       -1,1
          zero      0                   " lock
          zero      0,NL_break_table    " special packed address
          its       -1,1                " user info ptr
          dec       9                   " bytesize
          dec       511                 " upper bound
          dec       512                 " num bytes
          dec       0                   " byte offset

          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " NUL - BEL
          action    (NIL,NIL,HIT,NIL,NIL,NIL,NIL,NIL)       " BS - BRS
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " DLE - ETB
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " CAN - US
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " SP - '
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ( - /
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 0 - 7
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 8 - ?
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " @ - G
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " H - O
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " P - W
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " X - _
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ` - g
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " h - o
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " p - w
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " x - PAD
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 200 - 207
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 210 - 217
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 220 - 227
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 230 - 237
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 240 - 247
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 250 - 257
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 260 - 267
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 270 - 277
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 300 - 307
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 310 - 317
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 320 - 327
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 330 - 337
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 340 - 347
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 350 - 357
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 360 - 367
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 370 - 377
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 400 - 407
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 410 - 417
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 420 - 427
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 430 - 437
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 440 - 447
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 450 - 457
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 460 - 467
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 470 - 477
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 500 - 507
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 510 - 517
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 520 - 527
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 530 - 537
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 540 - 547
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 550 - 557
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 560 - 567
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 570 - 577
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 600 - 607
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 610 - 617
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 620 - 627
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 630 - 637
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 640 - 647
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 650 - 657
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 660 - 667
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 670 - 677
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 700 - 707
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 710 - 717
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 720 - 727
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 730 - 737
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 740 - 747
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 750 - 757
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 760 - 767
          action    (NIL,NIL,NIL,NIL,NIL,NIL,HIT,NIL)       " 770 - 777
                                                            " HIT is trans IAC

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

NL_delim_table:
                              " see net_buffer_header_dcls.incl.pl1 for
                              " for format of this header
          its       -1,1
          zero      0                   " lock
NL_delim_id:
          zero      0,NL_delim_table    " special packed address
          its       -1,1                " user info ptr
          dec       9                   " bytesize
          dec       511                 " upper bound
          dec       512                 " num bytes
          dec       0                   " byte offset

          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " NUL - BEL
          action    (NIL,NIL,HIT,NIL,NIL,NIL,NIL,NIL)       " BS - BRS
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " DLE - ETB
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " CAN - US
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " SP - '
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ( - /
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 0 - 7
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 8 - ?
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " @ - G
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " H - O
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " P - W
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " X - _
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ` - g
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " h - o
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " p - w
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " x - PAD
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 200 - 207
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 210 - 217
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 220 - 227
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 230 - 237
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 240 - 247
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 250 - 257
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 260 - 267
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 270 - 277
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 300 - 307
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 310 - 317
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 320 - 327
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 330 - 337
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 340 - 347
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 350 - 357
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 360 - 367
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 370 - 377
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 400 - 407
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 410 - 417
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 420 - 427
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 430 - 437
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 440 - 447
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 450 - 457
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 460 - 467
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 470 - 477
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 500 - 507
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 510 - 517
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 520 - 527
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 530 - 537
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 540 - 547
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 550 - 557
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 560 - 567
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 570 - 577
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 600 - 607
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 610 - 617
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 620 - 627
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 630 - 637
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 640 - 647
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 650 - 657
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 660 - 667
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 670 - 677
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 700 - 707
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 710 - 717
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 720 - 727
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 730 - 737
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 740 - 747
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 750 - 757
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 760 - 767
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 770 - 777


" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

OUR_DM_delim_table:
                              " see net_buffer_header_dcls.incl.pl1 for
                              " the format of this header
          its       -1,1
          zero      0                   " lock
          zero      0,OUR_DM_delim_table " special packed address
          its       -1,1                " user info ptr
          dec       9                   " bytesize
          dec       511                 " upper bound
          dec       512                 " num bytes
          dec       0                   " byte offset

          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " NUL - BEL
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " BS - BRS
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " DLE - ETB
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " CAN - US
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " SP - '
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ( - /
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 0 - 7
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 8 - ?
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " @ - G
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " H - O
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " P - W
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " X - _
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " ` - g
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " h - o
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " p - w
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " x - PAD
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 200 - 207
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 210 - 217
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 220 - 227
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 230 - 237
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 240 - 247
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 250 - 257
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 260 - 267
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 270 - 277
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 300 - 307
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 310 - 317
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 320 - 327
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 330 - 337
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 340 - 347
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 350 - 357
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 360 - 367
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 370 - 377
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 400 - 407
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 410 - 417
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 420 - 427
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 430 - 437
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 440 - 447
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 450 - 457
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 460 - 467
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 470 - 477
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 500 - 507
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 510 - 517
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 520 - 527
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 530 - 537
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 540 - 547
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 550 - 557
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 560 - 567
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 570 - 577
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 600 - 607
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 610 - 617
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 620 - 627
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 630 - 637
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 640 - 647
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 650 - 657
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 660 - 667
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 670 - 677
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 700 - 707
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 710 - 717
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 720 - 727
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 730 - 737
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 740 - 747
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 750 - 757
          action    (NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL)       " 760 - 767
          action    (NIL,NIL,NIL,HIT,NIL,NIL,NIL,NIL)       " 770 - 777
                                                            " HIT is translated DM

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

all_delim_table:
                              " see net_buffer_header_dcls.incl.pl1 for
                              " the format of this header
          its       -1,1
          zero      0                   " lock
          zero      0,all_delim_table   " special packed address
          its       -1,1                " user info ptr
          dec       9                   " bytesize
          dec       511                 " upper bound
          dec       512                 " num bytes
          dec       0                   " byte offset

          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " NUL - BEL
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " BS - BRS
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " DLE - ETB
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " CAN - US
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " SP - '
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " ( - /
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 0 - 7
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 8 - ?
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " @ - G
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " H - O
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " P - W
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " X - _
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " ` - g
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " h - o
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " p - w
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " x - PAD
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 200 - 207
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 210 - 217
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 220 - 227
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 230 - 237
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 240 - 247
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 250 - 257
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 260 - 267
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 270 - 277
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 300 - 307
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 310 - 317
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 320 - 327
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 330 - 337
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 340 - 347
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 350 - 357
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 360 - 367
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 370 - 377
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 400 - 407
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 410 - 417
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 420 - 427
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 430 - 437
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 440 - 447
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 450 - 457
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 460 - 467
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 470 - 477
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 500 - 507
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 510 - 517
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 520 - 527
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 530 - 537
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 540 - 547
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 550 - 557
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 560 - 567
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 570 - 577
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 600 - 607
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 610 - 617
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 620 - 627
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 630 - 637
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 640 - 647
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 650 - 657
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 660 - 667
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 670 - 677
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 700 - 707
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 710 - 717
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 720 - 727
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 730 - 737
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 740 - 747
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 750 - 757
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 760 - 767
          action    (HIT,HIT,HIT,HIT,HIT,HIT,HIT,HIT)       " 770 - 777


" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
          end




		    net_character_xtach_.pl1        09/23/77  1034.5rew 09/22/77  1725.3      412866



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_character_xtach_:
          procedure (P_SDB_ptr);

/*             "net_character_xtach_" -- this procedure contains the entry        */
/*        points associated with maintaining the attachment (through the I/O    */
/*        switch) for a stream using this IOSIM.                                */

/*        Originally created by D. M. Wells 1973, December 17.                  */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_open_mode fixed binary (17),
          P_size fixed binary (24),
          P_delim_count fixed binary (24),
          P_event_channel fixed binary (71),
          P_error_code fixed binary (35),
          P_report_sw bit (1),                              /* on if we should use com_err_ to report errors  */
          P_delim_id bit (36),
          (P_new_modes, P_old_modes, P_request) character (*),
          P_descrip_args (*) character (*) varying,
          P_delim_ptr pointer,
          P_request_ptr pointer,                            /* pointer to additional info about control calls */
          P_attach_descrip_ptr pointer,                     /* points to a varying string with attach descrip */
          P_open_descrip_ptr pointer,                       /* points to a varying string with open descrip   */
          P_SDB_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (num_pins_to_allocate fixed binary (8),
          arg_indx fixed binary (17),
          indx fixed binary (24),
          err_code fixed binary (35),
          delimiter_set_id bit (36),
          attach_device character (64) varying,
          control_args_description character (128) varying,
          SDB_ptr pointer,
          (buff_ptr, delim_ptr) pointer,
          abort_attach variable entry options (variable))
               automatic;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          IOSIM character (32) varying initial ("net_character_")
               internal static options (constant);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_fb35 fixed binary (35),
          based_area area)
               based;

     declare
          1 SDB aligned based,                              /* Stream Data Block as allocated from storage    */
             2 template aligned like SDB_template,          /* template as other programs might know it       */
             2 attachment_info aligned,
                3 foreign_host fixed binary (16),
                3 contact_socket fixed binary (32),
                3 attach_type fixed binary (17),            /* Normal, Privileged attach, accept passoff      */
                3 connection_mode fixed binary (10),        /* None, ICP, Listen, Initiate.                   */
                3 attachment_modes unaligned,
                   4 force_full_duplex bit (1),             /* whether we should always get 2 net connections */
                   4 attach_pad bit (35),

                3 net_socket_group fixed binary (24),       /* process socket group at time of attachment     */
                3 r_local_pin fixed binary (8),             /* pin num (within socket-group) of the read pin  */
                3 w_local_pin fixed binary (8),             /* pin num (within socket-group) of the write pin */

                3 first_pin fixed binary (8),               /* first pin in sequence we are to use            */
                3 num_allocated_pins fixed binary (8),      /* how many pins we have allocated (0 if none)    */

             2 opening_info aligned,
                3 open_mode fixed binary (17),              /* iox type opening mode                          */
                3 open_ev_chn_list_ptr pointer,             /* points to ev chn list if async open            */
                3 open_ev_chn fixed binary (71),            /* opening if non-zero                            */
             2 device_name character (64) unaligned,
             2 attach_description character (128) unaligned varying,
             2 open_description character (28) unaligned varying;

     declare
          1 based_delim unaligned based,
             2 byte (0 : 1) bit (9) unaligned;

     declare
          1 char_buffer aligned based,
             2 header like net_buffer_header,
             2 workspace aligned,
                3 byte (0 : 0 refer (char_buffer.buffer_bound)) bit (9) unaligned;

     declare
          1 special_write_struc aligned based,
             2 count fixed binary (24),
             2 workspace (0 refer (special_write_struc.count)) bit (9) unaligned;
     declare
          1 socket_info_struc (0 : 1) aligned based,
             2 socket_state fixed binary (6),
             2 local_socket fixed binary (32),
             2 foreign_host fixed binary (16),
             2 foreign_socket fixed binary (32);

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
          net_character_tables_$nontype6_link_verification fixed binary (35)
               external static;

     declare
         (error_table_$bad_arg,
          error_table_$bad_conversion,
          error_table_$bad_mode,                            /* we didn't understand the mode the guy wanted   */
          error_table_$badopt,
          error_table_$device_active,
          error_table_$invalid_device,
          error_table_$invalid_elsize,
          error_table_$ionmat,                              /* code indicating stream already attached        */
          error_table_$net_icp_not_concluded,
          error_table_$no_linkage,
          error_table_$noarg,
          error_table_$undefined_order_request,
          error_table_$wrong_no_of_args)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          com_err_ constant entry options (variable),
          cu_$arg_list_ptr constant entry () returns (ptr),
          cu_$gen_call constant entry (entry, ptr),
          cv_dec_check_ constant entry (char (*), fixed bin (35)) returns (fixed bin (35)),
          get_process_id_ constant entry () returns (bit (36) aligned),
          get_system_free_area_ constant entry () returns (ptr),
          hcs_$wakeup constant entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
          interpret_socket_spec_ constant entry (char (*), fixed bin (16), fixed bin (32), fixed bin (8), fixed bin (35)),
          ioa_$ioa_switch constant entry options (variable),
          ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$delete_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$reset_ev_call_chn constant entry (fixed bin (71), fixed bin (35)),
          ncp_$detach_socket constant entry (bit (36), fixed bin (35)),
          ncp_$get_foreign_socket constant entry (bit (36), fixed bin (16), fixed bin (32), fixed bin (6), fixed bin (35)),
          ncp_$get_local_socket constant entry (bit (36), fixed bin (16), fixed bin (32), fixed bin (6), fixed bin (35)),
          ncp_$send_interrupt constant entry (bit (36), fixed bin (6), fixed bin (35)),
          net_async_support_$insert_in_channel_list constant entry (ptr, fixed bin (71), fixed bin (35)),
          net_async_support_$notify_all_channels constant entry (ptr, fixed bin (35)),
          net_async_support_$setup_event_channel constant entry (ptr, fixed bin (71), fixed bin (35)),
          net_buffer_man_$allocate_buffer constant entry (fixed bin (24), fixed bin (24), fixed bin (35)) returns (ptr),
          net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)),
          net_buffer_man_$initialize_buffer constant entry (ptr, fixed bin (24), fixed bin (24), fixed bin (35)),
          net_character_io_$nc_put_chars_raw constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35)),
          net_connect_$abort_connection constant entry (fixed bin (8), fixed bin (35)),
          net_connect_$abort_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (35)),
          net_connect_$complete_connection constant entry (fixed bin (8), fixed bin (71), fixed bin (71),
                    fixed bin (16), fixed bin (32), bit (36), bit (36), fixed bin (35)),
          net_connect_$complete_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (71), fixed bin (71),
                    fixed bin (16), fixed bin (32), bit (36), bit (36), fixed bin (35)),
          net_connect_$open_connection constant entry (fixed bin (8), fixed bin (17), fixed bin (16), fixed bin (32),
                    bit (2), fixed bin (17), fixed bin (71), fixed bin (35)),
          net_connect_$open_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (17), fixed bin (16), fixed bin (32),
                    bit (2), fixed bin (17), fixed bin (71), fixed bin (35)),
          net_iosim_open_$conclude_opening constant entry (fixed bin (24), fixed bin (8), fixed bin (17), bit (2), fixed bin (8), fixed bin (10), fixed bin (16), fixed bin (32), fixed bin (17), fixed bin (71), bit (36), bit (36), fixed bin (71), fixed bin (71), fixed bin (35)),
          net_iosim_open_$initiate_opening constant entry (fixed bin (24), fixed bin (8), fixed bin (17), bit (2), fixed bin (8), fixed bin (10), fixed bin (16), fixed bin (32), fixed bin (17), fixed bin (71), bit (36), bit (36), fixed bin (71), fixed bin (71), fixed bin (35)),
          net_mode_parser_ constant entry (char (*), entry (char (*) varying, bit (*), ptr, fixed bin (35)), fixed bin (35)),
          net_pin_manager_$allocate_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)),
          net_pin_manager_$free_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35));

     declare
          (addr, baseno, binary, dimension, hbound, lbound, length, mod, null, rel, string, stac, substr)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          cleanup
               condition;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include iox_modes;
          % include net_character_sdb_dcls;
          % include net_buffer_header_dcls;
          % include net_iosim_constants;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

return_to_caller:
          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      "report_and_abort_attachment" -- internal procedure to handle */
                                        /* all attach errors.  It will call com_err_ with its arguments iff  */
                                        /* the "P_report_sw" switch is set.  In any case, it will return      */
                                        /* to the caller of the attach entry point after setting the          */
                                        /* status code to indicate no attachment was done.                    */

report_and_abort_attachment:
          procedure (P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if P_report_sw
          then call cu_$gen_call (com_err_, (cu_$arg_list_ptr ()));

          P_error_code = P_err_code;
          if SDB_ptr ^= null ()
          then call release_SDB (SDB_ptr);

          goto return_to_caller;

end;      /* end report_and_abort_attachment               */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

net_character_:                                   /* entry to attach primitive net character IOSIM            */
          entry (P_SDB_ptr, P_descrip_args, P_report_sw, P_attach_descrip_ptr, P_error_code);

          P_error_code = 0;

          SDB_ptr = null ();

          on cleanup
               call release_SDB (SDB_ptr);

          abort_attach = report_and_abort_attachment;       /* setup abort procedure for the attach call      */

          if dimension (P_descrip_args, 1) < 2
          then call abort_attach (error_table_$noarg, IOSIM, "Form is: ^a host,socket -connect <type>", IOSIM);

          SDB_ptr = acquire_SDB (P_SDB_ptr);

          attach_device = "";
          control_args_description = "";
          SDB_ptr -> SDB.attach_description = "";

          string (SDB_ptr -> SDB.attachment_modes) = ""b;   /* clear any special flags                        */
          SDB_ptr -> SDB.connection_mode = NO_CONNECTION;
          SDB_ptr -> SDB.attach_type = ATTACH_SOCKET;       /* default is to do normal attachment to sockets  */
          SDB_ptr -> SDB.first_pin = -1;                    /* we don't have any first pin specified yet      */

          do arg_indx = lbound (P_descrip_args, 1) by 1 to hbound (P_descrip_args, 1);
               call process_argument (P_descrip_args (arg_indx), arg_indx);
               end;

          if SDB_ptr -> SDB.first_pin = -1
          then if SDB_ptr -> SDB.attach_type ^= ATTACH_SOCKET
               then call abort_attach (error_table_$noarg, IOSIM, "The -socket_group ctl arg was given without -local_pin.");

          SDB_ptr -> SDB.attach_description = IOSIM || " " || attach_device || control_args_description;

          if attach_device = ""
          then do;
               if (SDB_ptr -> SDB.connection_mode ^= LISTEN_CONNECTION) & (SDB_ptr -> SDB.connection_mode ^= NO_CONNECTION)
               then call abort_attach (error_table_$noarg, IOSIM, "An attach specification (host,socket) must be given.");
               SDB_ptr -> SDB.foreign_host = -1;
               SDB_ptr -> SDB.contact_socket = -1;
               end;
          else do;
               call interpret_socket_spec_ ((attach_device), SDB_ptr -> SDB.foreign_host,
                         SDB_ptr -> SDB.contact_socket, (0), err_code);
               if err_code ^= 0
               then call abort_attach (err_code, IOSIM, "Unable to interpret socket name ^a", attach_device);
               end;

          if SDB_ptr -> SDB.first_pin = -1
          then do;
               if SDB_ptr -> SDB.connection_mode = ICP_CONNECTION
               then num_pins_to_allocate = 4;
               else num_pins_to_allocate = 2;

               call net_pin_manager_$allocate_pins (num_pins_to_allocate, SDB_ptr -> SDB.first_pin, err_code);
               if err_code ^= 0
               then call abort_attach (err_code, IOSIM, "Unable to allocate any local network pins.");

               SDB_ptr -> SDB.num_allocated_pins = num_pins_to_allocate;

               end;

          if SDB_ptr -> SDB.connection_mode = ICP_CONNECTION
          then SDB_ptr -> SDB.r_local_pin = SDB_ptr -> SDB.first_pin + 2;
          else SDB_ptr -> SDB.r_local_pin = SDB_ptr -> SDB.first_pin;

          SDB_ptr -> SDB.w_local_pin = SDB_ptr -> SDB.r_local_pin + 1;

          if mod (SDB_ptr -> SDB.r_local_pin, 2) ^= 0
          then call abort_attach (error_table_$invalid_device, IOSIM, "Wrong gender specified for local pin.");

          string (SDB_ptr -> SDB.current_modes) = ""b;
          call nc_modes (SDB_ptr, "ascii", (""), err_code);
          if err_code ^= 0
          then call abort_attach (err_code, IOSIM, "Attempting to set default ascii mode.");

          SDB_ptr -> SDB.timeout_value = 15;

          P_SDB_ptr = SDB_ptr;

          P_attach_descrip_ptr = addr (SDB_ptr -> SDB.attach_description);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_detach:
          entry (P_SDB_ptr, P_attach_descrip_ptr, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;                              /* get private copy of callers arg                */

          if SDB_ptr = null ()
          then return;                                      /* probably a mixup in cleanup invocation         */

          call nc_async_close (SDB_ptr, (null ()), 0, (0));

          on cleanup
               call release_SDB (P_SDB_ptr);                /* use callers arg for cleanup in case problems   */

          P_attach_descrip_ptr = null ();                   /* attachment is officially undone by this        */
          on cleanup
               call release_SDB (SDB_ptr);                  /* now use our copy of ptr as we are detached     */

          P_SDB_ptr = null ();                              /* user doesn't have data block anymore           */

          call release_SDB (SDB_ptr);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_async_open:
          entry (P_SDB_ptr, P_open_mode, P_descrip_args, P_open_descrip_ptr, P_event_channel, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;

          SDB_ptr -> SDB.open_mode = P_open_mode;

          if SDB_ptr -> SDB.open_mode ^= Stream_input_output
          then if SDB_ptr -> SDB.open_mode ^= Stream_output
               then if SDB_ptr -> SDB.open_mode ^= Stream_input
                    then do;
                         P_error_code = error_table_$bad_mode;
                         return;
                         end;

          if SDB_ptr -> SDB.open_ev_chn_list_ptr = null ()
          then do;
               call initiate_opening (P_error_code);
               end;
          else do;
               call conclude_opening (P_error_code);
               end;

          if P_error_code ^= 0
          then if P_error_code ^= error_table_$device_active
               then call nc_async_close (SDB_ptr, P_open_descrip_ptr, 0, (0));

          if P_error_code ^=0
          then return;

          call net_async_support_$setup_event_channel (SDB_ptr -> SDB.read_ev_chn_list_ptr,
                    SDB_ptr -> SDB.ncp_read_ev_chn, P_error_code);
          if P_error_code ^= 0
          then return;

          call net_async_support_$setup_event_channel (SDB_ptr -> SDB.write_ev_chn_list_ptr,
                    SDB_ptr -> SDB.ncp_write_ev_chn, P_error_code);
          if P_error_code ^= 0
          then return;

          call net_buffer_man_$initialize_buffer (addr (SDB_ptr -> SDB.initial_input_buffer),
                    dimension (SDB_ptr -> SDB.initial_input_buffer.byte, 1), 9, P_error_code);
          if P_error_code ^= 0
          then return;

          call net_buffer_man_$initialize_buffer (addr (SDB_ptr -> SDB.initial_output_buffer),
                    dimension (SDB_ptr -> SDB.initial_output_buffer.byte, 1), 8, P_error_code);
          if P_error_code ^= 0
          then return;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_async_close:
          entry (P_SDB_ptr, P_open_descrip_ptr, P_event_channel, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;

          if SDB_ptr -> SDB.open_ev_chn_list_ptr ^= null ()
          then do;
               if SDB_ptr -> SDB.net_socket_group = -1
               then call net_connect_$abort_connection (SDB_ptr -> SDB.first_pin, (0));
               else call net_connect_$abort_priv_connection (SDB_ptr -> SDB.net_socket_group, SDB_ptr -> SDB.first_pin, (0));
               end;

          call ncp_$detach_socket (SDB_ptr -> SDB.r_ncp_idx, (0));
          SDB_ptr -> SDB.r_ncp_idx = ""b;

          call ncp_$detach_socket (SDB_ptr -> SDB.w_ncp_idx, (0));
          SDB_ptr -> SDB.w_ncp_idx = ""b;

          call deassign_ipc_channel (SDB_ptr -> SDB.ncp_read_ev_chn);
          call deassign_ipc_channel (SDB_ptr -> SDB.ncp_write_ev_chn);
          call deassign_ipc_channel (SDB_ptr -> SDB.open_ev_chn);

          call free_buffer (SDB_ptr -> SDB.read_ev_chn_list_ptr);
          call free_buffer (SDB_ptr -> SDB.write_ev_chn_list_ptr);
          call free_buffer (SDB_ptr -> SDB.open_ev_chn_list_ptr);

          call free_buffer (SDB_ptr -> SDB.input_ptr);
          call free_buffer (SDB_ptr -> SDB.output_ptr);

          P_open_descrip_ptr = null ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_control:                                                 /* entry to issue typewriter order calls          */
          entry (P_SDB_ptr, P_request, P_request_ptr, P_error_code);

          P_error_code = 0;                                 /* initialize status word to zero                 */

          SDB_ptr = P_SDB_ptr;

          if P_request = "start"
          then do;
               call ipc_$reset_ev_call_chn (SDB_ptr -> SDB_template.ncp_read_ev_chn, (0));
               call hcs_$wakeup (get_process_id_ (), SDB_ptr -> SDB_template.ncp_read_ev_chn, 0, (0));

               call ipc_$reset_ev_call_chn (SDB_ptr -> SDB_template.ncp_read_ev_chn, (0));
               call hcs_$wakeup (get_process_id_ (), SDB_ptr -> SDB_template.ncp_write_ev_chn, 0, (0));
               return;
               end;


          if P_request = "get_socket_states"
          then do;
               call fillin_socket_info (SDB_ptr -> SDB_template.r_ncp_idx, P_request_ptr -> socket_info_struc (0));
               call fillin_socket_info (SDB_ptr -> SDB_template.w_ncp_idx, P_request_ptr -> socket_info_struc (1));
               return;
               end;

          if P_request = "send_INS"
          then do;
               call ncp_$send_interrupt (SDB_ptr -> SDB.w_ncp_idx, (0), P_error_code);
               return;
               end;

          if P_request = "send_INR"
          then do;
               call ncp_$send_interrupt (SDB_ptr -> SDB.r_ncp_idx, (0), P_error_code);
               return;
               end;

          if P_request = "send_TELNET_control"
          then do;
               call net_character_io_$nc_put_chars_raw (SDB_ptr, addr (P_request_ptr -> special_write_struc.workspace),
                         P_request_ptr -> special_write_struc.count, (0), P_error_code);
               return;
               end;

          if P_request = "timeout"
          then do;
               SDB_ptr -> SDB_template.timeout_value = P_request_ptr -> based_fb35;
               return;
               end;

          if P_request = "trace"
          then do;
               if P_request_ptr ^= null
               then call ioa_$ioa_switch (P_request_ptr, "Tracing to iocb at ^p", P_request_ptr);

               SDB_ptr -> SDB_template.trace_iocb_ptr = P_request_ptr;
               return;
               end;

          P_error_code = error_table_$undefined_order_request;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_setsize:
          entry (P_SDB_ptr, P_size, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;

          if P_size ^= 9
          then P_error_code = error_table_$invalid_elsize;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_getsize:                                                 /* entry to return current element size           */
          entry (P_SDB_ptr, P_size, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;

          P_size = 9;                                       /* element size for terminals is always 9         */

          return;                                           /* so return the constant 9 to the caller         */

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_modes:
          entry (P_SDB_ptr, P_new_modes, P_old_modes, P_error_code);

          P_error_code = 0;                         /* initialize status code to zero                 */

          SDB_ptr = P_SDB_ptr;

          call change_modes (P_new_modes, P_old_modes, P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

nc_create_delim_set:
          entry (P_SDB_ptr, P_delim_ptr, P_delim_count, P_delim_id, P_error_code);

          P_error_code = 0;

          SDB_ptr = P_SDB_ptr;

          delim_ptr = P_delim_ptr;
          if (P_delim_count < 0)
          then do;
               P_error_code = error_table_$bad_arg;
               return;
               end;

          if P_delim_count > 0
          then delimiter_set_id = delim_ptr -> based_delim.byte (0);  /* feel the first char to check access  */

          buff_ptr = net_buffer_man_$allocate_buffer (512, 9, P_error_code);
          if P_error_code ^= 0
          then return;

          buff_ptr -> char_buffer.header.num_bytes = 512;
          string (buff_ptr -> char_buffer.workspace) = ""b;

          do indx = 0 by 1 to P_delim_count - 1;
               buff_ptr -> char_buffer.workspace.byte (binary (delim_ptr -> based_delim.byte (indx), 9)) = (9)"1"b;
               end;

          delimiter_set_id = baseno (buff_ptr) || rel (buff_ptr);
          buff_ptr -> char_buffer.user_data = delimiter_set_id;

          buff_ptr -> char_buffer.user_info_ptr = SDB_ptr -> SDB_template.delim_list_ptr;
          SDB_ptr -> SDB_template.delim_list_ptr = buff_ptr;

          P_delim_id = delimiter_set_id;

          P_error_code = 0;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

change_modes:
          procedure (P_new_modes, P_old_modes, P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_err_code fixed binary (35),
          P_new_modes character (*),
          P_old_modes character (*))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         ((jdex, mode_count) fixed binary (24),
          (mode_mentioned, newm, oldm) bit (3),
          old_modes character (128) varying)
               automatic;

          /* * * * * CONSTANT DECLARATIONS * * * * * * * * */

     declare
          modestr (3) character (8) varying initial ("ascii", "telnet", "direct")
               internal static options (constant);

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          newm, oldm = string (P_SDB_ptr -> SDB_template.current_modes.mode_switches);    /* get cur modes    */

                                                            /* figure out the mode string for current modes   */
          old_modes = "";
          do jdex = 1 to hbound (modestr, 1);
               if length (old_modes) ^= 0
               then old_modes = old_modes || ",";

               if ^ substr (oldm, jdex, 1)                  /* if "^" needed                                  */
               then old_modes = old_modes || "^";           /* insert "^" to denote that this option is off   */

               old_modes = old_modes || modestr (jdex);     /* insert mode name for this mode                 */
               end;

          P_old_modes = old_modes;

                                                            /* now weve got the old modes, figure out the new */
          mode_mentioned = ""b;

          call net_mode_parser_ (P_new_modes, interpret_key, P_err_code);
          if P_err_code ^= 0
          then return;

          if mode_mentioned ^= ""b
          then newm = newm & mode_mentioned;                /* do this so can say "ascii" (e.g.) and not      */
                                                            /* get two modes on at the same time.             */

          mode_count = 0;
          do jdex = 1 by 1 to hbound (modestr, 1);
               if substr (newm, jdex, 1)
               then mode_count = mode_count + 1;
               end;

          if mode_count ^= 1
          then do;                                /* exactly one conversion mode must be on                   */
               P_error_code = error_table_$bad_mode;
               return;
               end;

          SDB_ptr -> SDB_template.modes_inconsistent = "1"b;
          string (P_SDB_ptr -> SDB_template.current_modes.mode_switches) = newm;
          SDB_ptr -> SDB_template.modes_inconsistent = "0"b;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


interpret_key:
          procedure (P_key, P_info_bits, P_data_ptr, P_error_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_error_code fixed binary (35),
          P_info_bits bit (*),
          P_key character (*) varying,
          P_data_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (mode_desired_on bit (1),
          integer_value_exists bit (1))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_error_code = 0;

          mode_desired_on = "1"b;                           /* default is to make the mode go on              */
          integer_value_exists = "0"b;                      /* default is that no integer was decoded         */

          if length (P_info_bits) >= 1
          then mode_desired_on = substr (P_info_bits, 1, 1);

          if length (P_info_bits) >= 2
          then integer_value_exists = substr (P_info_bits, 2, 1);

          do jdex = 1 by 1 to hbound (modestr, 1)
                    while (P_key ^= modestr (jdex));     /* search for P_key             */
               end;
          if jdex <= hbound (modestr, 1)     /* if found                             */
          then do;
               substr (mode_mentioned, jdex, 1) = "1"b;
               substr (newm, jdex, 1) = mode_desired_on;

               return;
               end;

          P_error_code = error_table_$bad_mode;

          return;

end;      /* end interpret_key                              */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

end;      /* end change_modes                               */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

fillin_socket_info:
          procedure (P_sock_indx, P_info_struc);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_sock_indx bit (36)
               parameter;

     declare
          1 P_info_struc aligned parameter like socket_info_struc;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          err_code fixed binary (35)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call ncp_$get_foreign_socket (P_sock_indx, P_info_struc.foreign_host, P_info_struc.foreign_socket, (0), err_code);
          if err_code ^= 0
          then P_info_struc.foreign_host, P_info_struc.foreign_socket = -1;

          call ncp_$get_local_socket (P_sock_indx, (0), P_info_struc.local_socket, P_info_struc.socket_state, err_code);
          if err_code ^= 0
          then do;
               P_info_struc.local_socket = -1;
               P_info_struc.socket_state = 0;
               end;

          return;

end;      /* end fillin_socket_info                        */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

initialize_buffer:
          procedure (P_buffer_ptr);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_buffer_ptr pointer
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_buffer_ptr = null ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

free_buffer:
          entry (P_buffer_ptr);

          if P_buffer_ptr ^= null ()
          then do;
               call net_buffer_man_$free_buffer (P_buffer_ptr, (0));
               P_buffer_ptr = null ();
               end;

          return;

end;      /* end initialize_buffer                         */


/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

assign_ipc_channel:
          procedure (P_ipc_channel, p_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_err_code fixed binary (35),
          P_ipc_channel fixed binary (71))
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call ipc_$create_ev_chn (P_ipc_channel, p_err_code);
          if p_err_code ^= 0
          then do;
               P_ipc_channel = 0;
               return;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

deassign_ipc_channel:
          entry (P_ipc_channel);

          if P_ipc_channel ^= 0
          then do;
               call ipc_$delete_ev_chn (P_ipc_channel, (0));
               P_ipc_channel = 0;
               end;

          return;

end;      /* end assign_ipc_channel                        */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

initiate_opening:
          procedure (P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * */

     declare
           desired_sockets bit (2)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * */

          SDB_ptr -> SDB.open_description = iox_modes (SDB_ptr -> SDB.open_mode);

          if SDB_ptr -> SDB.open_mode = Stream_input_output
          then desired_sockets = "11"b;
          else if SDB_ptr -> SDB.open_mode = Stream_output
               then desired_sockets = "01"b;
               else if SDB_ptr -> SDB.open_mode = Stream_input
                    then desired_sockets = "10"b;
                    else do;
                         P_err_code = error_table_$bad_mode;
                         return;
                         end;

          if SDB_ptr-> SDB.force_full_duplex
          then desired_sockets = "11"b;                     /* user can ask to always get two connections,    */
                                                            /* even though he will only use one direction.    */
                                                            /* This is useful with PL/I I/O.                  */

          call net_iosim_open_$initiate_opening (SDB_ptr -> SDB.net_socket_group, SDB_ptr -> SDB.first_pin, SDB_ptr -> SDB.attach_type,
                    desired_sockets, 8, SDB_ptr -> SDB.connection_mode,
                    SDB_ptr -> SDB.foreign_host, SDB_ptr -> SDB.contact_socket,
                    SDB_ptr -> SDB.timeout_value, SDB_ptr -> SDB.open_ev_chn,
                    SDB_ptr -> SDB.r_ncp_idx, SDB_ptr -> SDB.w_ncp_idx,
                    SDB_ptr -> SDB.ncp_read_ev_chn, SDB_ptr -> SDB.ncp_write_ev_chn, P_err_code);
          if (P_err_code ^= error_table_$device_active)
          then return;

          call net_async_support_$setup_event_channel (SDB_ptr -> SDB.open_ev_chn_list_ptr,
                    SDB_ptr -> SDB.open_ev_chn, P_err_code);
          if P_err_code ^= 0
          then return;

          call reset_connect_wakeups ("0"b);

          P_open_descrip_ptr = addr (SDB_ptr -> SDB.open_description);

          P_err_code = error_table_$device_active;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * */

conclude_opening:
          entry (P_err_code);

          call net_iosim_open_$conclude_opening (SDB_ptr -> SDB.net_socket_group, SDB_ptr -> SDB.first_pin, SDB_ptr -> SDB.attach_type,
                    desired_sockets, 8, SDB_ptr -> SDB.connection_mode,
                    (0), (0),
                    SDB_ptr -> SDB.timeout_value, SDB_ptr -> SDB.open_ev_chn,
                    SDB_ptr -> SDB.r_ncp_idx, SDB_ptr -> SDB.w_ncp_idx,
                    SDB_ptr -> SDB.ncp_read_ev_chn, SDB_ptr -> SDB.ncp_write_ev_chn, P_error_code);
          if P_err_code ^= 0
          then do;
               if P_err_code = error_table_$device_active
               then do;
                    call reset_connect_wakeups ("0"b);
                    return;
                    end;
               end;

          call reset_connect_wakeups ("1"b);

          if P_err_code ^= 0
          then return;

          call free_buffer (SDB_ptr -> SDB.open_ev_chn_list_ptr);

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

reset_connect_wakeups:
          procedure (P_connection_concluded);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_connection_concluded bit (1)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if P_connection_concluded
          then call net_async_support_$notify_all_channels (SDB_ptr -> SDB.open_ev_chn_list_ptr, (0));
          else call net_async_support_$insert_in_channel_list (SDB_ptr -> SDB.open_ev_chn_list_ptr, P_event_channel, (0));

          return;

end;      /* end reset_connect_wakeups                     */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

end;      /* end initiate_opening                          */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

process_argument:
          procedure (p_control_arg, p_arg_indx);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          (p_arg_indx fixed binary (17),
          p_control_arg character (*) varying)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if p_control_arg = ""
          then return;

          if substr (p_control_arg, 1, 1) ^= "-"
          then do;
               if attach_device ^= ""
               then call abort_attach (error_table_$wrong_no_of_args, IOSIM, "Only one foreign socket specification may be given.");

               attach_device = p_control_arg;
               return;
               end;

          if p_control_arg = "-connect"
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_descrip_args, 1)
               then call abort_attach (error_table_$noarg, IOSIM, "No connection type specified with -connect.");

               if SDB_ptr -> SDB.connection_mode ^= NO_CONNECTION
               then call abort_attach (error_table_$wrong_no_of_args, IOSIM, "Only one specification of -connect may be given.");

               if P_descrip_args (p_arg_indx) = "initiate"
               then SDB_ptr -> SDB.connection_mode = INITIATE_CONNECTION;
               else if P_descrip_args (p_arg_indx) = "listen"
                    then SDB_ptr -> SDB.connection_mode = LISTEN_CONNECTION;
                    else if P_descrip_args (p_arg_indx) = "icp"
                         then SDB_ptr -> SDB.connection_mode = ICP_CONNECTION;
                         else if P_descrip_args (p_arg_indx) = "none"
                              then SDB_ptr -> SDB.connection_mode = NO_CONNECTION;
                              else call abort_attach (error_table_$bad_arg, IOSIM, "Valid args to -connect are:  initiate, connect, icp.");

               control_args_description = control_args_description || " -connect ";
               control_args_description = control_args_description || P_descrip_args (p_arg_indx);

               return;
               end;

          if p_control_arg = "-local_pin"
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_descrip_args, 1)
               then call abort_attach (error_table_$wrong_no_of_args, IOSIM, "No pin specified with -local_pin.");

               SDB_ptr -> SDB.first_pin = cv_dec_check_ ((P_descrip_args (p_arg_indx)), err_code);
               if err_code ^= 0
               then call abort_attach (error_table_$bad_conversion, IOSIM, "Arg to -local_pin is not a decimal integer:  ^a", P_descrip_args (p_arg_indx));

               if (SDB_ptr -> SDB.first_pin < 0) | (SDB_ptr -> SDB.first_pin > 255)
               then call abort_attach (error_table_$bad_arg, IOSIM, "A pin number must be in the range 0 to 255.");

               control_args_description = control_args_description || " -local_pin ";
               control_args_description = control_args_description || P_descrip_args (p_arg_indx);

               return;
               end;

          if (p_control_arg = "-socket_group") | (p_control_arg = "-sg")
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_descrip_args, 1)
               then call abort_attach (error_table_$wrong_no_of_args, IOSIM, "No socket_group specified with -socket_group.");

               SDB_ptr -> SDB.net_socket_group = cv_dec_check_ ((P_descrip_args (p_arg_indx)), err_code);
               if err_code ^= 0
               then call abort_attach (error_table_$bad_conversion, IOSIM, "Arg to -socket_group is not a decimal integer:  ^a", P_descrip_args (p_arg_indx));

               if (SDB_ptr -> SDB.net_socket_group < 0) | (SDB_ptr -> SDB.net_socket_group > 16777215)
               then call abort_attach (error_table_$bad_arg, IOSIM, "A socket_group must be in the range 0 to 16777215.");

               if SDB_ptr -> SDB.attach_type = ATTACH_SOCKET
               then SDB_ptr -> SDB.attach_type = ATTACH_PRIV_SOCKET;  /* promote attach type.  Might also     */
                                                                      /* already be accept passoff.           */

               control_args_description = control_args_description || " -socket_group ";
               control_args_description = control_args_description || P_descrip_args (p_arg_indx);

               return;
               end;

          if (p_control_arg = "-accept_passoff")
          then do;
               SDB_ptr -> SDB.attach_type = ATTACH_PASSOFF_SOCKET;

               control_args_description = control_args_description || " -accept_passoff";

               return;
               end;

          if (p_control_arg = "-full_duplex")
          then do;
               SDB_ptr -> SDB.force_full_duplex = "1"b;

               control_args_description = control_args_description || " -full_duplex";

               return;
               end;

          call abort_attach (error_table_$badopt, IOSIM, P_descrip_args (p_arg_indx));

end;      /* end process_argument                           */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

acquire_SDB:
          procedure (p_SDB_ptr) returns (ptr);

          /* * * * * PARAMETER DECLARATIONS * * * * * * * */

     declare
          p_SDB_ptr pointer
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (area_ptr, temp_ptr) pointer
               automatic;

          /* * * * * INTERNAL STATIC DECLARATIONS  * * * * */

     declare
          static_SDB_lock bit (36) initial ((36)""b)
               internal static;

     declare
          1 static_SDB aligned internal static like SDB;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if p_SDB_ptr ^= null ()
          then call abort_attach (error_table_$ionmat, IOSIM, "Attempt to create a multiple attachment.");

          if stac (addr (static_SDB_lock), "1"b)
          then do;
               temp_ptr = addr (static_SDB);
               temp_ptr -> SDB.storage_management.allocation_ptr = null ();
               end;
          else do;
               area_ptr = get_system_free_area_ ();

               allocate SDB in (area_ptr -> based_area) set (temp_ptr);

               temp_ptr -> SDB.storage_management.allocation_ptr = area_ptr;
               end;


          if net_character_tables_$nontype6_link_verification = 0
          then call abort_attach (error_table_$no_linkage, IOSIM, "net_character_tables_ was created and not found.");

          temp_ptr -> SDB.delim_list_ptr = null ();
          temp_ptr -> SDB.trace_iocb_ptr = null ();

          temp_ptr -> SDB.read_ev_chn_list_ptr = null ();
          temp_ptr -> SDB.write_ev_chn_list_ptr = null ();
          temp_ptr -> SDB.open_ev_chn_list_ptr = null ();

          temp_ptr -> SDB.input_ptr = null ();
          temp_ptr -> SDB.output_ptr = null ();

          temp_ptr -> SDB.open_ev_chn = 0;
          temp_ptr -> SDB.ncp_read_ev_chn = 0;
          temp_ptr -> SDB.ncp_write_ev_chn = 0;

          temp_ptr -> SDB.num_allocated_pins = 0;

          temp_ptr -> SDB.net_socket_group = -1;
          temp_ptr -> SDB.r_ncp_idx = ""b;
          temp_ptr -> SDB.w_ncp_idx = ""b;

          return (temp_ptr);

          /* * * * * * * * * * * * * * * * * * * * * * * */

release_SDB:
          entry (p_SDB_ptr);

          temp_ptr = p_SDB_ptr;
          p_SDB_ptr = null ();

          if temp_ptr = null ()
          then return;

          if temp_ptr -> SDB.r_ncp_idx ^= ""b
          then call ncp_$detach_socket (temp_ptr -> SDB.r_ncp_idx, (0));

          if temp_ptr -> SDB.w_ncp_idx ^= ""b
          then call ncp_$detach_socket (temp_ptr -> SDB.w_ncp_idx, (0));

          if temp_ptr -> SDB.num_allocated_pins > 0
          then call net_pin_manager_$free_pins (temp_ptr -> SDB.num_allocated_pins, temp_ptr -> SDB.first_pin, (0));

          if temp_ptr = addr (static_SDB)
          then static_SDB_lock = ""b;
          else if temp_ptr -> SDB.storage_management.allocation_ptr ^= null ()
               then free temp_ptr -> SDB in (temp_ptr -> SDB.storage_management.allocation_ptr -> based_area);

          return;

end;      /* end acquire_SDB                               */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_character_xtach_                      */
end;




		    net_convert_size_.pl1           09/23/77  1034.5rew 09/22/77  1725.3      237519



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_convert_size_:
          procedure ();

/*             "net_convert_size_" -- a collection of procedures used in        */
/*        converting from Network characters (8 bits) to Multics characters (9  */
/*        bits).  The most common subsets of conversions are here so that, if   */
/*        necessary, this module can be converted to assembly language for      */
/*        efficiency.                                                           */
/*             The interfaces to all entries in this module are identical:      */
/*        The info_ptr is ignored (but is here because it makes the calling     */
/*        sequence of this entries similar to others having to do with code     */
/*        conversion (and someday, it just might be useful).                    */
/*        The input_ptr and output_ptr parameters point to an I/O workspace     */
/*        (i.e., word aligned).  The next_XXX argument indicates the next       */
/*        available (from the beginning) byte to be read from/stored into.      */
/*        The last_XXX argument indicates the last available byte.  Notice      */
/*        that the next_XXX argument is thus both an input and an output arg.   */

/*        Originally written by D. M. Wells 30 April, 1974.                     */


          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_first_in fixed binary (24),                     /* first byte in workspace to process             */
          P_num_in fixed binary (24),                       /* num bytes in workspace to process              */
          P_num_in_proc fixed binary (24),                  /* num bytes in workspace processed               */
          P_first_out fixed binary (24),                    /* first available byte in output workspace       */
          P_num_out fixed binary (24),                      /* num bytes available in output workspace        */
          P_num_out_proc fixed binary (24),                 /* num bytes processed to output workspace         */

          P_error_code fixed binary (35),                   /* always returned as zero                         */
          P_info_ptr pointer,                               /* unused, makes arg list similar to other procs  */
          P_input_ptr pointer,                              /* points to input I/O workspace                  */
          P_output_ptr pointer)                             /* points to output I/O workspace                 */
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (byte_num_in fixed binary (3),                     /* byte offset (within element) of next input     */
          byte_num_out fixed binary (3),                    /* byte offset (within element) of next output    */
          next_in fixed binary (24),                        /* always indicates next input byte               */
          next_out fixed binary (24),                       /* always indicates next output byte              */
          last_in fixed binary (24),                        /* indicates last input byte                      */
          last_out fixed binary (24),                       /* indicates last output byte                     */
          string_offset fixed binary (18),
          current_byte bit (9),
          temp_byte bit (9),                                /* used to remember last byte during lookahead    */
          in_string_ptr pointer,                            /* points to current input element                */
          out_string_ptr pointer,                           /* points to current output element               */
          input_ptr pointer,                               /* automatic copy of P_input_ptr                 */
          output_ptr pointer)                              /* automatic copy of P_output_ptr                */
               automatic;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
         (NUL       initial ("000000000"b),
          NL        initial ("000001010"b),
          CR        initial ("000001101"b),
          SP        initial ("000100000"b),
          PAD       initial ("001111111"b),
          Max_Byte  initial ("011111111"b))
               bit (9) internal static options (constant);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_bit72_algn bit (72) aligned,
          based_bit36_array (0 : 1) bit (36) aligned,
          based_bit72_array (0 : 1) bit (72) aligned)
               based;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
          error_table_$chars_after_delim
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          (addr, substr)
               builtin;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include telnet_special_chars;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

in_middle_of_input_sequence:
          call copy_back_parameters ();

          P_error_code = error_table_$chars_after_delim;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

out_of_input_bytes:
out_of_output_space:
          call copy_back_parameters ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This entry point does a particular translation of Multics     */
                                        /* ASCII to Network ASCII.  In particular, it only implements the     */
                                        /* CR-LF -> NL, CR-NUL -> CR, and NUL -> /0 conversions.  In general,  */
                                        /* programs will have to do separate translations for conversions     */
                                        /* not performed here.  These other translations can generally be     */
                                        /* performed by a PL/1 translate statement.                           */

ascii_8_to_9:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_8_bits ();

               if current_byte >= SP                        /* (SPACE) -- All controls are less than space    */
               then call store_9_bits ();                   /* non-control, just store it                     */
               else if current_byte = CR
                    then do;                                /* this is a CR, look at next char for info       */
                         if next_in + 1 > last_in
                         then goto in_middle_of_input_sequence;       /* see if we can look at one more char  */

                         next_in = next_in + 1;             /* update to next character                       */
                         call fetch_8_bits ();              /* fetch the next input byte                      */
                         if current_byte = NL
                         then call store_9_bits ();         /* store this NL character                        */
                         else if current_byte = NUL
                              then do;
                                   current_byte = CR;                 /* this was CR-NUL, store a CR          */
                                   call store_9_bits ();
                                   end;
                              else do;                      /* PROTOCOL VIOLATION -- but attempt to recover   */
                                   current_byte = CR;                /* pick up a CR again                   */
                                   call store_9_bits ();              /* and store it                         */

                                   next_in = next_in - 1;             /* back down on the input byte num      */
                                   byte_num_in = -1;                  /* and cause recomputation of byte num  */
                                   end;
                         end;
                    else if current_byte ^= NUL                       /* pass through all but NULs            */
                         then call store_9_bits ();
               end;

          call copy_back_parameters ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This entry converts from 8 bits to 9 bits, but is for the use */
                                        /* of programs using the TELNET protocol.  All IACs in the input      */
                                        /* are converted to an internal form of IAC.  The use of this is that */
                                        /* such programs can retranslate all such tIAC-tIAC to a data IAC     */
                                        /* and can use the tIAC as an end of processed input pointer.         */

telnet_8_to_9:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_8_bits ();

               if current_byte = NET_IAC
               then current_byte = OUR_IAC;

               call store_9_bits ();
               end;

          call copy_back_parameters ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This entry converts from 8 bits to 9 bits (and nothing else). */

direct_8_to_9:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_8_bits ();

               call store_9_bits ();
               end;

          call copy_back_parameters ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This entry point translates from 9 bits to 8 bits and in the  */
                                        /* process converts Multics ASCII to Network ASCII.  This includes    */
                                        /* NL -> CR-LF, CR -> CR-NUL, PAD -> /0.                               */

ascii_9_to_8:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_9_bits ();

               if current_byte >= SP
               then do;                                     /* if above SP                                    */
                    if current_byte ^= PAD         
                    then call store_8_bits ();              /* then store, if not a PAD                       */
                    end;
               else do;                                     /* else this is a control character               */
                    if current_byte = NL
                    then do;                                /* this is a NL character, handle specially       */
                         if next_out + 1 > last_out
                         then goto out_of_output_space;     /* we dont have enough room left, give up         */

                         current_byte = CR;                 /* NL gets replaced by CR-LF                      */
                         call store_8_bits ();
                         current_byte = NL;
                         call store_8_bits ();
                         end;
                    else if current_byte = CR
                         then do;                           /* this is a CR character, handler specially      */
                              if next_out + 1 > last_out
                              then goto out_of_output_space;          /* not enough room left, give up        */

                              call store_8_bits ();         /* store the CR and then follow it by a NUL       */
                              current_byte = NUL;
                              call store_8_bits ();
                              end;
                         else call store_8_bits ();         /* otherwise, just store the random character     */
                    end;

               end;

          call copy_back_parameters ();

          return;

          /* * * * * * * * * ** * * * * * * * * * * * * * */

                                        /*      This entry point translates from 9 bits to 8 bits and in the  */
                                        /* process doubles any IACs that it may find.  Thus this entry may be */
                                        /* used by a TELNET processor to write out data (as opposed to        */
                                        /* TELNET commands).                                                  */

telnet_9_to_8:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_9_bits ();

               if current_byte = NET_IAC
               then call store_8_bits ();

               call store_8_bits ();
               end;

          call copy_back_parameters ();

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This entry converts from 9 bits to 8 bits (and nothing else). */

direct_9_to_8:
          entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc,
                    P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code);

          call copy_in_parameters ();

          do next_in = next_in by 1 to last_in;
               call fetch_9_bits ();

               call store_8_bits ();
               end;

          call copy_back_parameters ();

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

copy_in_parameters:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_error_code = 0;

          byte_num_in = -1;
          byte_num_out = -1;

          input_ptr = P_input_ptr;
          next_in = P_first_in;
          last_in = P_first_in + P_num_in - 1;

          output_ptr = P_output_ptr;
          next_out = P_first_out;
          last_out = P_first_out + P_num_out - 1;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

copy_back_parameters:
          entry ();

          P_num_out_proc = next_out - P_first_out;
          P_num_in_proc = next_in - P_first_in;

          return;

end;      /* end copy_in_parameters                        */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

fetch_8_bits:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          goto fetch_eight (byte_num_in);

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (-1):
          string_offset = divide (next_in, 9, 24, 0);       /* which 72-bit element are we referencing        */
          byte_num_in = next_in - 9 * string_offset;        /* now which 8-bit byte in that element           */
          in_string_ptr = addr (input_ptr -> based_bit72_array (string_offset));          /* addr of element  */

          goto fetch_eight (byte_num_in);


                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (0):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 1, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 1, but use an "aos" instruction        */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (1):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 9, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 2, but use an "aos" instruction        */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (2):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 17, 8);
          byte_num_in = byte_num_in + 1;

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (3):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 25, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 4, but use an "aos" instruction        */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (4):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 33, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 5                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (5):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 41, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 6                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (6):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 49, 8);
          byte_num_in = byte_num_in + 1;                    /* will be 7                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (7):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 57, 8);
          byte_num_in = byte_num_in + 1;

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_eight (8):
          current_byte = "0"b || substr (in_string_ptr -> based_bit72_algn, 65, 8);
          byte_num_in = 0;
          in_string_ptr = addr (in_string_ptr -> based_bit72_array (1));        /* move to next element       */

          return;

end fetch_8_bits;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

store_9_bits:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if next_out > last_out
          then goto out_of_output_space;

          next_out = next_out + 1;

          goto store_nine (byte_num_out);

                    /* * * * * * * * * * * * * * * * * * * */

store_nine (-1):
          string_offset = divide ((next_out - 1), 4, 18, 0);          /* which 36-bit element is referenced   */
          byte_num_out = (next_out - 1) - 4 * string_offset;          /* which byte in that 36-bit element    */
          out_string_ptr = addr (output_ptr -> based_bit36_array (string_offset));        /* addr of element  */

          goto store_nine (byte_num_out);

                    /* * * * * * * * * * * * * * * * * * * */

store_nine (0):
          substr (out_string_ptr -> based_bit72_algn, 1, 9) = current_byte;
          byte_num_out = byte_num_out + 1;                    /* will be 1, but use "aos" instruction           */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_nine (1):
          substr (out_string_ptr -> based_bit72_algn, 10, 9) = current_byte;
          byte_num_out = byte_num_out + 1;                    /* will be 2, but use "aos" instruction           */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_nine (2):
          substr (out_string_ptr -> based_bit72_algn, 19, 9) = current_byte;
          byte_num_out = byte_num_out + 1;                    /* will be 3                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_nine (3):
          substr (out_string_ptr -> based_bit72_algn, 28, 9) = current_byte;
          byte_num_out = 0;
          out_string_ptr = addr (out_string_ptr -> based_bit36_array (1));      /* move to next element       */

          return;

end store_9_bits;
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

store_8_bits:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if next_out > last_out
          then goto out_of_output_space;

          next_out = next_out + 1;

          goto store_eight (byte_num_out);

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (-1):
          string_offset = divide ((next_out - 1), 9, 18, 0);          /* which 72-bit element is referenced   */
          byte_num_out = (next_out - 1) - 9 * string_offset;          /* which byte in that 72-bit element    */
          out_string_ptr = addr (output_ptr -> based_bit72_array (string_offset));        /* addr of element  */

          goto store_eight (byte_num_out);

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (0):
          substr (out_string_ptr -> based_bit72_algn, 1, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* will be 1, but use an "aos" instruction        */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (1):
          substr (out_string_ptr -> based_bit72_algn, 9, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* wil be 1, but use an "aos" instruction         */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (2):
          substr (out_string_ptr -> based_bit72_algn, 17, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (3):
          substr (out_string_ptr -> based_bit72_algn, 25, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* will be 4, but use an "aos" instruction        */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (4):
          substr (out_string_ptr -> based_bit72_algn, 33, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* will be 5                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (5):
          substr (out_string_ptr -> based_bit72_algn, 41, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* will be 6                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (6):
          substr (out_string_ptr -> based_bit72_algn, 49, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;                  /* will be 7                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (7):
          substr (out_string_ptr -> based_bit72_algn, 57, 8) = substr (current_byte, 2, 8);
          byte_num_out = byte_num_out + 1;

          return;

                    /* * * * * * * * * * * * * * * * * * * */

store_eight (8):
          substr (out_string_ptr -> based_bit72_algn, 65, 8) = substr (current_byte, 2, 8);

          byte_num_out = 0;
          out_string_ptr = addr (out_string_ptr -> based_bit72_array (1));      /* move to next element       */

          return;

end store_8_bits;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

fetch_9_bits:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          goto fetch_nine (byte_num_in);

                    /* * * * * * * * * * * * * * * * * * * */

fetch_nine (-1):
          string_offset = divide (next_in, 4, 18, 0);       /* which 36-bit element are we referencing        */
          byte_num_in = next_in - 4 * string_offset;        /* which byte in that 36-bit element              */
          in_string_ptr = addr (input_ptr -> based_bit36_array (string_offset));          /* addr of element  */

          goto fetch_nine (byte_num_in);

                    /* * * * * * * * * * * * * * * * * * * */

fetch_nine (0):
          current_byte = substr (in_string_ptr -> based_bit72_algn, 1, 9);
          byte_num_in = byte_num_in + 1;                    /* will be 1, but use "aos" instruction           */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_nine (1):
          current_byte = substr (in_string_ptr -> based_bit72_algn, 10, 9);
          byte_num_in = byte_num_in + 1;                    /* will be 2, but use "aos" instruction           */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_nine (2):
          current_byte = substr (in_string_ptr -> based_bit72_algn, 19, 9);
          byte_num_in = byte_num_in + 1;                    /* will be 3                                      */

          return;

                    /* * * * * * * * * * * * * * * * * * * */

fetch_nine (3):
          current_byte = substr (in_string_ptr -> based_bit72_algn, 28, 9);
          byte_num_in = 0;
          in_string_ptr = addr (in_string_ptr -> based_bit36_array (1));        /* move to next element       */

          return;

end fetch_9_bits;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	/* end net_convert_size_		         */
end;




		    net_data_transfer_.pl1          09/23/77  1034.5rew 09/22/77  1725.3      394515



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_data_transfer_:
          procedure ();

/*             This procedure implements the attachment and control side of     */
/*        of the Network IOSIM that handles arbitrary size Network connections. */

/*        Originally created by D. M. Wells.                                    */

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_open_mode fixed binary (17),                    /* mode of opening to stream                      */
          P_size fixed binary (24),
          P_extend_bit bit (1) aligned,                     /* on if we are to append to end of previous      */
          P_report_sw bit (1) aligned,                      /* on if we should use com_err_ to report errors  */
          P_error_code fixed binary (35),                   /* standard Multics error code                    */
          (P_new_modes, P_old_modes) character (*),         /* arguments to modes entry point                 */
          P_request character (*),                          /* request being made of control entry point      */
          P_attach_args (*) character (*) varying,          /* arguments to attach call                       */
          P_info_ptr pointer,                               /* pointer to data for control entry point        */
          P_IOCB_ptr pointer)                               /* pointer to IOCB associated with switch         */
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (mode_temp fixed binary (3),
          rsexec_local_pin fixed binary (8),
	arg_indx fixed binary (17),
	foreign_socket fixed binary (32),
          err_code fixed binary (35),
          connection_desired bit (2),
          temp_mode_string character (32),
          device character (32) varying,
	device_description character (64) varying,
	control_args_description character (128) varying,
          (area_ptr, SDB_ptr) pointer,
          attach_abort variable entry options (variable))   /* procedure var to hold attach_abort handler for attach */
               automatic;

          /* * * * * TEXT SECTION REFERENCES * * * * * * * */

     declare
          IOSIM character (32) varying initial ("net_data_transfer_")
               internal static options (constant);

     declare
         (STREAM_INPUT_MODE             initial (1),
          STREAM_OUTPUT_MODE            initial (2),
          STREAM_INPUT_OUTPUT_MODE      initial (3))
               fixed binary (17) internal static options (constant);

     declare
         (ACTIVE_STATE        initial (1),
          LISTENING_STATE     initial (2),
          RFC_RCVD_STATE      initial (3),
          OPEN_STATE          initial (6),
          DATA_WAIT_STATE     initial (9))
               fixed binary (6) internal static options (constant);

     declare
         (UNSPECIFIED	initial (-1),
	PASSOFF		initial (10),
          ICP                 initial (11),
          LISTEN              initial (12),
          INITIATE            initial (13))
               fixed binary (17) internal static options (constant);

          /* * * * * DEFINED REFERENCES  * * * * * * * * * */

     declare
          1 IOCB aligned like iocb_template defined (P_IOCB_ptr -> iocb_template.actual_iocb_ptr -> iocb_template);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_element_size fixed binary (24),
          based_fixed_bin35 fixed binary (35),
          based_area area)
               based;

     declare
          1 SDB aligned based,
             2 common aligned like SDB_template,
             2 attach_description character (96) varying,
             2 open_description character (32) varying;

     declare
          1 read_status_struc aligned based,
             2 ev_chn fixed binary (71),
             2 input_available bit (1) unaligned,
	   2 padd bit (35) unaligned;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$bad_arg,
          error_table_$bad_mode,
          error_table_$bad_segment,
	error_table_$badopt,
	error_table_$invalid_device,
          error_table_$invalid_elsize,
          error_table_$not_detached,
          error_table_$noarg,
          error_table_$undefined_order_request,
          error_table_$wrong_no_of_args)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          com_err_ constant entry options (variable),
          cu_$arg_list_ptr constant entry () returns (ptr),
          cu_$gen_call constant entry (entry, ptr),
	cv_dec_check_ constant entry (char (*), fixed bin (35)) returns (fixed bin (35)),
          get_system_free_area_ constant entry () returns (ptr),
          interpret_socket_spec_ constant entry (char (*), fixed bin (16), fixed bin (32), fixed bin (8), fixed bin (35)),
          iox_$err_not_attached constant entry options (variable),
          iox_$err_not_closed constant entry options (variable),
          iox_$err_not_open constant entry options (variable),
          iox_$propagate constant entry (ptr),
          ipc_$block constant entry (ptr, ptr, fixed bin (35)),
          ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ipc_$delete_ev_chn constant entry (fixed bin (71), fixed bin (35)),
          ncp_$accept_passoff constant entry (fixed bin (24), fixed bin (8), fixed bin (71), bit (36), fixed bin (35)),
          ncp_$attach_socket constant entry (fixed bin (8), fixed bin (71), bit (36), fixed bin (35)),
          ncp_$attach_priv_socket constant entry (fixed bin (24), fixed bin (8), fixed bin (71), bit (36), fixed bin (35)),
          ncp_$close_connection constant entry (bit (36), fixed bin (6), fixed bin (35)),
          ncp_$detach_socket constant entry (bit (36), fixed bin (35)),
          ncp_$discard_buffered_data constant entry (bit (36), fixed bin (6), fixed bin (35)),
          ncp_$get_bytesize constant entry (bit (36), fixed bin (8), fixed bin (35)),
	ncp_$get_foreign_socket constant entry (bit (36), fixed bin (16), fixed bin (32), fixed bin (6), fixed bin (35)),
	ncp_$get_local_socket constant entry (bit (36), fixed bin (16), fixed bin (32), fixed bin (6), fixed bin (35)),
	ncp_$get_socket_state constant entry (bit (36), fixed bin (6), fixed bin (35)),
          ncp_$get_userid constant entry (fixed bin (24), fixed bin (35)),
          ncp_$set_bytesize constant entry (bit (36), fixed bin (8), fixed bin (35)),
          net_connect_$abort_connection constant entry (fixed bin (8), fixed bin (35)),
          net_connect_$abort_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (35)),
          net_connect_$complete_connection constant entry (fixed bin (8), fixed bin (71), fixed bin (71),
                    fixed bin (16), fixed bin (32), bit (36), bit (36), fixed bin (35)),
          net_connect_$complete_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (71), fixed bin (71),
                    fixed bin (16), fixed bin (32), bit (36), bit (36), fixed bin (35)),
          net_connect_$open_connection constant entry (fixed bin (8), fixed bin (17), fixed bin (16), fixed bin (32),
                    bit (2), fixed bin (17), fixed bin (71), fixed bin (35)),
          net_connect_$open_priv_connection constant entry (fixed bin (24), fixed bin (8), fixed bin (17), fixed bin (16), fixed bin (32),
                    bit (2), fixed bin (17), fixed bin (71), fixed bin (35)),
          net_data_transfer_io_$ndt_fill_static_buffer constant entry (ptr, fixed bin (35)),
          net_data_transfer_io_$net_data_xfer_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35)),
          net_data_transfer_io_$net_data_xfer_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (35)),
          net_mode_parser_ constant entry (char (*), entry (char (*) varying, bit (*), ptr, fixed bin (35)), fixed bin (35)),
          net_pin_manager_$allocate_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)),
          net_pin_manager_$free_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)),
          timer_manager_$sleep constant entry (fixed bin (71), bit (2));

     declare
          (addr, binary, bit, hbound, lbound, length, null, string, substr)
               builtin;

          /* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
          cleanup
               condition;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_data_transfer_dcls;
          % include net_event_template;
          % include net_iocb_template_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

return_to_caller:
          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_transfer_attach:
          entry (P_IOCB_ptr, P_attach_args, P_report_sw, P_error_code);

          P_error_code = 0;                                 /* setup for a successful return                  */

	SDB_ptr = null ();				/* make null so that abort proc won't try to free one	*/

          attach_abort = report_error_and_abort;            /* setup eror handler for attach entry point      */

          if IOCB.attach_descrip_ptr ^= null ()
          then call attach_abort (error_table_$not_detached, IOSIM, "^a", IOCB.name);

          if dimension (P_attach_args, 1) < 2
          then call attach_abort (error_table_$noarg, IOSIM, "^a (device -connect type)?", IOCB.name);

	on cleanup
	     call release_SDB ();

	call acquire_SDB ();

	SDB_ptr -> SDB.attach_description = IOSIM;

	string (SDB_ptr -> SDB.control_bits) = ""b;
	SDB_ptr -> SDB.timeout_period = 15;
	SDB_ptr -> SDB.connection_mode = UNSPECIFIED;
	SDB_ptr -> SDB.userid = -1;

	device_description = "";
	control_args_description = "";

	do arg_indx = lbound (P_attach_args, 1) by 1 to hbound (P_attach_args, 1);
	     call process_argument (P_attach_args (arg_indx), arg_indx);
	     end;

	if SDB_ptr -> SDB.connection_mode = UNSPECIFIED
	then call attach_abort (error_table_$bad_arg, IOSIM, "No connection type specified (-connect <type>).");

	if device_description ^= ""
	then SDB_ptr -> SDB.attach_description = SDB_ptr -> SDB.attach_description || " " || device_description;

	SDB_ptr -> SDB.attach_description = SDB_ptr -> SDB.attach_description || " " || control_args_description;

	call interpret_connection_mode ();

          SDB_ptr -> SDB.parameters.xfer_mode = 1;

          IOCB.detach_iocb = net_data_xfer_detach;
	IOCB.modes = net_data_xfer_modes;
	IOCB.control = net_data_xfer_control;
          IOCB.open = net_data_xfer_open;

          IOCB.attach_data_ptr = SDB_ptr;
          IOCB.attach_descrip_ptr = addr (SDB_ptr -> SDB.attach_description);

          SDB_ptr -> SDB.byte_size = 8;            /* for this IOSIM, default bytesize is 8          */

          call iox_$propagate (addr (IOCB));

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

                                        /*      This is an internal procedure to handle all attach errors.    */
                                        /* It will call com_err_ with its arguments iff the "P_report_sw"     */
                                        /* switch is set.  In any case, it will return to the caller of the   */
                                        /* attach entry point after setting the status code.                  */

report_error_and_abort:
          procedure (P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * * */

     declare
          P_err_code fixed binary (35)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if P_report_sw
          then call cu_$gen_call (com_err_, (cu_$arg_list_ptr ()));

          P_error_code = P_err_code;
          goto return_to_caller;

end;      /* end report_error_and_abort                    */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_detach:
          entry (P_IOCB_ptr, P_error_code);

          P_error_code = 0;

          SDB_ptr = IOCB.attach_data_ptr;

	call release_SDB ();

          IOCB.attach_descrip_ptr = null ();
          IOCB.attach_data_ptr = null ();

          IOCB.detach_iocb = iox_$err_not_attached;
          IOCB.open = iox_$err_not_attached;

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_open:
          entry (P_IOCB_ptr, P_open_mode, P_extend_bit, P_error_code);

          P_error_code = 0;

          SDB_ptr = IOCB.attach_data_ptr;

          if P_open_mode = STREAM_INPUT_MODE
          then do;
               SDB_ptr -> SDB.open_description = "stream_input";
               connection_desired = "10"b;
               end;
          else if P_open_mode = STREAM_OUTPUT_MODE
               then do;
                    SDB_ptr -> SDB.open_description = "stream_output";
                    connection_desired = "01"b;
                    end;
               else if P_open_mode = STREAM_INPUT_OUTPUT_MODE
                    then do;
                         SDB_ptr -> SDB.open_description = "stream_input_output";
                         connection_desired = "11"b;
                         end;
                    else do;
                         P_error_code = error_table_$bad_mode;
                         return;
                         end;

          call ipc_$create_ev_chn (SDB_ptr -> SDB.read_connection.event_channel, P_error_code);
          if P_error_code ^= 0
          then return;

          call reset_data ();

          call ipc_$create_ev_chn (SDB_ptr -> SDB.write_connection.event_channel, P_error_code);
          if P_error_code ^= 0
          then return;

          SDB_ptr -> SDB.open_mode = P_open_mode;

          if SDB_ptr -> SDB.connection_mode = ICP
          then call activate_sockets (SDB_ptr -> SDB.local_pin + 2, P_error_code);
          else call activate_sockets (SDB_ptr -> SDB.local_pin + 0, P_error_code);
          if P_error_code ^= 0
          then return;

          if SDB_ptr -> SDB.connection_mode ^= PASSOFF
          then do;
               call begin_connection (SDB_ptr -> SDB.local_pin, SDB_ptr -> SDB.foreign_host, SDB_ptr -> SDB.foreign_socket, P_error_code);
               if P_error_code ^= 0
               then return;

               if ^ SDB_ptr -> SDB.want_async_open
               then do;
                    call conclude_connection (SDB_ptr -> SDB.local_pin, P_error_code);
                    if P_error_code ^= 0
                    then return;
                    end;
               end;

          IOCB.open_descrip_ptr = addr (SDB_ptr -> SDB.open_description);

          IOCB.open = iox_$err_not_closed;
          IOCB.close = net_data_transfer_close;
          IOCB.detach_iocb = iox_$err_not_closed;

          if SDB_ptr -> SDB.open_mode ^= STREAM_OUTPUT_MODE
          then do;
               IOCB.get_chars = net_data_transfer_io_$net_data_xfer_get_chars;
               end;
          if SDB_ptr -> SDB.open_mode ^= STREAM_INPUT_MODE
          then do;
               IOCB.put_chars = net_data_transfer_io_$net_data_xfer_put_chars;
               end;

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_transfer_close:
          entry (P_IOCB_ptr, P_error_code);

          P_error_code = 0;

          SDB_ptr = IOCB.attach_data_ptr;

          IOCB.open_descrip_ptr = null ();
          IOCB.detach_iocb = net_data_xfer_detach;
          IOCB.open = net_data_xfer_open;
          IOCB.close = iox_$err_not_open;
          IOCB.get_line = iox_$err_not_open;
          IOCB.get_chars = iox_$err_not_open;
          IOCB.put_chars = iox_$err_not_open;
          IOCB.position = iox_$err_not_open;

          if SDB_ptr -> SDB.conn_event_channel ^= 0
          then do;
               if SDB_ptr -> SDB.userid = -1
               then call net_connect_$abort_connection (SDB_ptr -> SDB.local_pin, (0));
               else call net_connect_$abort_priv_connection (SDB_ptr -> SDB.userid, SDB_ptr -> SDB.local_pin, (0));
               call ipc_$delete_ev_chn (SDB_ptr -> SDB.conn_event_channel, (0));
               SDB_ptr -> SDB.conn_event_channel = 0;
               end;

          if SDB_ptr -> SDB.connection_mode ^= PASSOFF
          then do;
               if (SDB_ptr -> SDB.open_mode ^= STREAM_INPUT_MODE) & (SDB_ptr -> SDB.xfer_mode = 1)
               then do;                                     /* outputing and stream mode, close connection    */
/*                  call ncp_$close_connection (SDB_ptr -> SDB.read_connection.ncp_indx, (0), (0)); */
                    call ncp_$close_connection (SDB_ptr -> SDB.write_connection.ncp_indx, (0), (0));
                    end;
               end;

          if SDB_ptr -> SDB.read_connection.event_channel ^= 0
          then do;
               call ipc_$delete_ev_chn (SDB_ptr -> SDB.read_connection.event_channel, (0));
               SDB_ptr -> SDB.read_connection.event_channel = 0;
               end;

          if SDB_ptr -> SDB.write_connection.event_channel ^= 0
          then do;
               call ipc_$delete_ev_chn (SDB_ptr -> SDB.write_connection.event_channel, (0));
               SDB_ptr -> SDB.write_connection.event_channel = 0;
               end;

          call iox_$propagate (addr (IOCB));

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_control:
          entry (P_IOCB_ptr, P_request, P_info_ptr, P_error_code);

          SDB_ptr = IOCB.attach_data_ptr;

	if P_request = "setsize"
	then do;
	     call net_data_xfer_setsize (P_IOCB_ptr, P_info_ptr -> based_element_size, P_error_code);
	     return;
	     end;

          if P_request = "asynchronous_open"
          then do;
               SDB_ptr -> SDB.want_async_open = "1"b;

               P_error_code = 0;
               return;
               end;

          if P_request = "get_chars_status"
          then do;
               if SDB_ptr -> SDB.xfer_mode ^= 1
               then do;                                     /* we only do this for stream mode                */
                    P_error_code = error_table_$bad_mode;
                    return;
                    end;

               call net_data_transfer_io_$ndt_fill_static_buffer (P_IOCB_ptr, P_error_code);
               if P_error_code ^= 0
               then return;

               if SDB_ptr -> SDB.xfer_buffer.num_bits = 0
               then do;
                    P_info_ptr -> read_status_struc.ev_chn = SDB_ptr -> SDB.read_connection.event_channel;
                    P_info_ptr -> read_status_struc.input_available = "0"b;
                    end;
               else do;
                    P_info_ptr -> read_status_struc.ev_chn = 0;
                    P_info_ptr -> read_status_struc.input_available = "1"b;
                    end;

               return;
               end;

	if P_request = "timeout"
	then do;
	     if P_info_ptr = null ()
	     then SDB_ptr -> SDB.timeout_period = 15;
	     else SDB_ptr -> SDB.timeout_period = P_info_ptr -> based_fixed_bin35;

	     return;
	     end;

          if P_request = "complete_open"
          then do;
               call conclude_connection (SDB_ptr -> SDB.local_pin, P_error_code);

               return;
               end;

	if P_request = "allow_partial_reads"
	then do;
	     SDB_ptr -> SDB.allow_partial_reads = "1"b;
	     return;
	     end;

	if P_request = "disallow_partial_reads"
	then do;
	     SDB_ptr -> SDB.allow_partial_reads = "0"b;
	     return;
	     end;

          if P_request = "rsexec_reconnect"
          then do;
               if SDB_ptr -> SDB.connection_mode = PASSOFF
               then do;
                    P_error_code = error_table_$bad_mode;
                    return;
                    end;

               call ncp_$get_foreign_socket (SDB_ptr -> SDB.write_connection.ncp_indx, (0), foreign_socket, (0), P_error_code);
               if P_error_code ^= 0
               then return;

               call ncp_$close_connection (SDB_ptr -> SDB.read_connection.ncp_indx, (0), (0));
               call ncp_$close_connection (SDB_ptr -> SDB.write_connection.ncp_indx, (0), (0));

               call wait_for_socket_to_quiesce (SDB_ptr -> SDB.read_connection.ncp_indx);
               call wait_for_socket_to_quiesce (SDB_ptr -> SDB.write_connection.ncp_indx);

               SDB_ptr -> SDB.byte_size = P_info_ptr -> based_element_size;

               if SDB_ptr -> SDB.connection_mode = ICP
               then rsexec_local_pin = SDB_ptr -> SDB.local_pin + 2;
               else rsexec_local_pin = SDB_ptr -> SDB.local_pin;

               call rsexec_connection (rsexec_local_pin, SDB_ptr -> SDB.foreign_host, foreign_socket, P_error_code);
               if P_error_code ^= 0
               then return;

               call conclude_connection (rsexec_local_pin, P_error_code);
               if P_error_code ^= 0
               then return;

               return;
               end;

          P_error_code = error_table_$undefined_order_request;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_setsize:
          entry (P_IOCB_ptr, P_size, P_error_code);

	P_error_code = 0;

	SDB_ptr = IOCB.attach_data_ptr;

          if IOCB.open_descrip_ptr ^= null ()
          then do;
               call iox_$err_not_closed (P_IOCB_ptr, P_request, P_info_ptr, P_error_code);
               return;
               end;

          if (P_size < 1) | (P_size > 255)
          then do;
               P_error_code = error_table_$invalid_elsize;
               return;
               end;

          SDB_ptr -> SDB.byte_size = P_size;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_getsize:
          entry (P_IOCB_ptr, P_size, P_error_code);

          SDB_ptr = IOCB.attach_data_ptr;

          P_error_code = 0;

          P_size = SDB_ptr -> SDB.byte_size;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_modes:
          entry (P_IOCB_ptr, P_new_modes, P_old_modes, P_error_code);

          SDB_ptr = IOCB.attach_data_ptr;

          P_error_code = 0;

          temp_mode_string = P_new_modes;
          mode_temp = SDB_ptr -> SDB.xfer_mode;

          if mode_temp = 1
          then P_old_modes = "stream";
          else if mode_temp = 2
               then P_old_modes = "block";
               else if mode_temp = 3
                    then P_old_modes = "compressed";
                    else do;
                         P_error_code = error_table_$bad_segment;
                         return;
                         end;

          call net_mode_parser_ (temp_mode_string, interpret_key, P_error_code);
          if P_error_code ^= 0
          then return;

          SDB_ptr -> SDB.xfer_mode = mode_temp;

          P_error_code = 0;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

reset_data:
          procedure ();

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          SDB_ptr -> SDB.xfer_buffer.bit_offset = 0;
          SDB_ptr -> SDB.xfer_buffer.num_bits = 0;

          SDB_ptr -> SDB.blocking.block_bytes_left = 0;
          SDB_ptr -> SDB.blocking.replication = 0;

          SDB_ptr -> SDB.blocking.descriptor_byte = ""b;

          return;

end;      /* end reset_data                                 */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

wait_for_socket_to_quiesce:
          procedure (p_socket_indx);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          p_socket_indx bit (36)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (sock_state fixed binary (6),
          num_tries fixed binary (17))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          sock_state = DATA_WAIT_STATE;
          do num_tries = 1 by 1 to 100 * SDB_ptr -> SDB.timeout_period
                    while ((sock_state ^= ACTIVE_STATE) & (sock_state ^= LISTENING_STATE));
               call timer_manager_$sleep (10000, "10"b);    /* wait for 10 msecs                    */

               call ncp_$get_socket_state (p_socket_indx, sock_state, P_error_code);
               if P_error_code ^= 0
               then goto return_to_caller;
               end;

          return;

end;      /* end wait_for_socket_to_quiesce                */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

activate_sockets:
          procedure (p_local_pin, P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_local_pin fixed binary (8),
          P_err_code fixed binary (35))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if SDB_ptr -> SDB.open_mode ^= STREAM_OUTPUT_MODE
          then do;
	     call attach_socket (p_local_pin + 0, SDB_ptr -> SDB.read_connection.event_channel,
		     SDB_ptr -> SDB.read_connection.ncp_indx, P_err_code);
               if P_err_code ^= 0
               then return;
               end;

          if SDB_ptr -> SDB.open_mode ^= STREAM_INPUT_MODE
	then do;
               call attach_socket (p_local_pin + 1, SDB_ptr -> SDB.write_connection.event_channel,
                         SDB_ptr -> SDB.write_connection.ncp_indx, P_err_code);
               if P_err_code ^= 0
               then return;

               end;

          P_err_code = 0;

          return;

	/* * * * * * * * * * * * * * * * * * * * * * * * */

close_sockets:
	entry ();

	call ncp_$close_connection (SDB_ptr -> SDB.read_connection.ncp_indx, (0), (0));
	call ncp_$close_connection (SDB_ptr -> SDB.write_connection.ncp_indx, (0), (0));

	return;

end;      /* end activate_sockets                          */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

set_bytesize:
          procedure (p_sock_indx, p_new_size, p_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_new_size fixed binary (8),
          p_err_code fixed binary (35),
          p_sock_indx bit (36))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          temp_size fixed binary (8)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call ncp_$get_bytesize (p_sock_indx, temp_size, p_err_code);
          if p_err_code ^= 0
          then return;

          if temp_size = p_new_size
          then return;                                      /* we don't want to change the value if we don't have to    */

          call ncp_$set_bytesize (p_sock_indx, p_new_size, p_err_code);

          return;

end;      /* end set_bytesize                              */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

attach_socket:
	procedure (p_pin_num, p_event_channel, p_socket_indx, p_err_code);

	/* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_pin_num fixed bin (8),
	p_err_code fixed binary (35),
	p_event_channel fixed binary (71),
	p_socket_indx bit (36))
	     parameter;

	/* * * * * * * * * * * * * * * * * * * * * * * * */

	if SDB_ptr -> SDB.userid = -1
          then call ncp_$attach_socket (p_pin_num, p_event_channel, p_socket_indx, p_err_code);
          else if SDB_ptr -> SDB.connection_mode = PASSOFF
               then call ncp_$accept_passoff (SDB_ptr -> SDB.userid, p_pin_num, p_event_channel,
                              p_socket_indx, p_err_code);
     	     else call ncp_$attach_priv_socket (SDB_ptr -> SDB.userid, p_pin_num, p_event_channel, p_socket_indx, p_err_code);
          if p_err_code ^= 0
          then return;

          call set_bytesize (p_socket_indx, SDB_ptr -> SDB.byte_size, p_err_code);
          if p_err_code ^= 0
          then do;
               call ncp_$discard_buffered_data (p_socket_indx, (0), (0));
               call ncp_$close_connection (p_socket_indx, (0), (0));

               call set_bytesize (p_socket_indx, SDB_ptr -> SDB.byte_size, p_err_code);
               end;

	return;

end;	/* end attach_socket		         */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

begin_connection:
          procedure (p_local_pin, P_foreign_host, P_foreign_socket, P_err_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_local_pin fixed binary (8),
          P_foreign_host fixed binary (16),
          P_foreign_socket fixed binary (32),
          P_err_code fixed binary (35))
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          conn_type fixed binary (17)
               automatic;

     declare
          1 event_message aligned automatic like event_message_template;

     declare
          1 event_list aligned automatic,
             2 num_chans fixed binary (17),
             2 event_channel fixed binary (71);

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call ipc_$create_ev_chn (SDB_ptr -> SDB.conn_event_channel, P_err_code);
          if P_err_code ^= 0
          then return;

          if SDB_ptr -> SDB.userid = -1
          then call net_connect_$open_connection (p_local_pin, SDB_ptr -> SDB.connection_mode,
                         P_foreign_host, P_foreign_socket, connection_desired, SDB_ptr -> SDB.timeout_period,
                         SDB_ptr -> SDB.conn_event_channel, P_err_code);
          else call net_connect_$open_priv_connection (SDB_ptr -> SDB.userid, p_local_pin, SDB_ptr -> SDB.connection_mode,
                         P_foreign_host, P_foreign_socket, connection_desired, SDB_ptr -> SDB.timeout_period,
                         SDB_ptr -> SDB.conn_event_channel, P_err_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

rsexec_connection:
          entry (p_local_pin, P_foreign_host, P_foreign_socket, P_err_code);

          call ipc_$create_ev_chn (SDB_ptr -> SDB.conn_event_channel, P_err_code);
          if P_err_code ^= 0
          then return;

          if SDB_ptr -> SDB.connection_mode = INITIATE
          then conn_type = LISTEN;
          else conn_type = INITIATE;

          call activate_sockets (p_local_pin, P_err_code);
          if P_err_code ^= 0
          then return;

          if SDB_ptr -> SDB.userid = -1
          then call net_connect_$open_connection (p_local_pin, conn_type,
                         P_foreign_host, P_foreign_socket, "11"b, SDB_ptr -> SDB.timeout_period,
                         SDB_ptr -> SDB.conn_event_channel, P_error_code);
          else call net_connect_$open_priv_connection (SDB_ptr -> SDB.userid, p_local_pin, conn_type,
                         P_foreign_host, P_foreign_socket, "11"b, SDB_ptr -> SDB.timeout_period,
                         SDB_ptr -> SDB.conn_event_channel, P_error_code);
          if P_error_code ^= 0
          then return;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

conclude_connection:
          entry (p_local_pin, P_err_code);

          event_list.num_chans = 1;
          event_list.event_channel = SDB_ptr -> SDB.conn_event_channel;

          call ipc_$block (addr (event_list), addr (event_message), P_err_code);
          if P_err_code ^= 0
          then return;

          if SDB_ptr -> SDB.userid = -1
          then call net_connect_$complete_connection (p_local_pin,
                         SDB_ptr -> SDB.read_connection.event_channel, SDB_ptr -> SDB.write_connection.event_channel,
                         (0), (0), SDB_ptr -> SDB.read_connection.ncp_indx, SDB_ptr -> SDB.write_connection.ncp_indx,
                         P_err_code);
          else call net_connect_$complete_priv_connection (SDB_ptr -> SDB.userid, p_local_pin,
                         SDB_ptr -> SDB.read_connection.event_channel, SDB_ptr -> SDB.write_connection.event_channel,
                         (0), (0), SDB_ptr -> SDB.read_connection.ncp_indx, SDB_ptr -> SDB.write_connection.ncp_indx,
                         P_err_code);

          call ipc_$delete_ev_chn (SDB_ptr -> SDB.conn_event_channel, (0));
          SDB_ptr -> SDB.conn_event_channel = 0;

          if P_err_code ^= 0
          then return;

          P_err_code = 0;

          return;

end;      /* end begin_connection                          */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

interpret_key:
          procedure (P_key, P_info_bits, P_data_ptr, P_error_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_error_code fixed binary (35),
          P_info_bits bit (*),
          P_key character (*) varying,
          P_data_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (mode_desired_on bit (1),
          integer_value_exists bit (1))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_error_code = 0;

          mode_desired_on = "1"b;
          integer_value_exists = "0"b;

          if length (P_info_bits) >= 1
          then mode_desired_on = substr (P_info_bits, 1, 1);

          if length (P_info_bits) >= 2
          then integer_value_exists = substr (P_info_bits, 2, 1);

          if ^ mode_desired_on
          then do;
               P_error_code = error_table_$bad_mode;
               return;
               end;

          if P_key = "stream"
          then do;
               mode_temp = 1;
               return;
               end;

          if P_key = "block"
          then do;
               mode_temp = 2;
               return;
               end;

          if P_key = "compressed"
          then do;
               mode_temp = 3;
               return;
               end;

          P_error_code = error_table_$bad_mode;

          return;

end;      /* end interpret_key                             */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

acquire_SDB:
          procedure ();

	/* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
	(temp_ipc_chan fixed binary (71),
	temp_ncp_indx bit (36),
	temp_ptr pointer)
	     automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          area_ptr = get_system_free_area_ ();

          allocate SDB in (area_ptr -> based_area) set (temp_ptr);
          temp_ptr -> SDB.area_ptr = area_ptr;

          temp_ptr -> SDB.conn_event_channel = 0;
          temp_ptr -> SDB.read_connection.event_channel = 0;
          temp_ptr -> SDB.write_connection.event_channel = 0;

	temp_ptr -> SDB.open_mode = 0;
	temp_ptr -> SDB.connection_mode = UNSPECIFIED;

          temp_ptr -> SDB.read_connection.ncp_indx = ""b;
          temp_ptr -> SDB.write_connection.ncp_indx = ""b;

	temp_ptr -> SDB.foreign_host = -1;
	temp_ptr -> SDB.foreign_socket = -1;
          temp_ptr -> SDB.local_pin = -1;

          temp_ptr -> SDB.xfer_buffer.num_bits = 0;
          temp_ptr -> SDB.xfer_buffer.bit_offset = 0;
          temp_ptr -> SDB.blocking.block_bytes_left = 0;
          temp_ptr -> SDB.blocking.replication = 0;
          temp_ptr -> SDB.blocking.descriptor_byte = ""b;

          SDB_ptr = temp_ptr;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

release_SDB:
          entry ();

          temp_ptr = SDB_ptr;
          SDB_ptr = null ();

          if temp_ptr = null ()
          then return;

          do temp_ncp_indx = temp_ptr -> SDB.read_connection.ncp_indx, temp_ptr -> SDB.write_connection.ncp_indx;
               call ncp_$detach_socket (temp_ncp_indx, err_code);
               end;

          do temp_ipc_chan = temp_ptr -> SDB.conn_event_channel, temp_ptr -> SDB.read_connection.event_channel,
                    temp_ptr -> SDB.write_connection.event_channel;
               call ipc_$delete_ev_chn (temp_ipc_chan, err_code);
               end;

          if temp_ptr -> SDB.num_pins_allocated ^= 0
          then call net_pin_manager_$free_pins (temp_ptr -> SDB.num_pins_allocated,
                         temp_ptr -> SDB.local_pin, err_code);

          area_ptr = temp_ptr -> SDB.area_ptr;

          free temp_ptr -> SDB in (area_ptr -> based_area);

          return;

end;      /* end acquire_SDB                               */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

interpret_connection_mode:
	procedure ();

	/* * * * * * * * * * * * * * * * * * * * * * * * */

          if SDB_ptr -> SDB.connection_mode = PASSOFF
          then do;
               if SDB_ptr -> SDB.local_pin = -1
               then call attach_abort (error_table_$bad_arg, IOSIM, "No local pin specification with ""passoff"".");

               SDB_ptr -> SDB.foreign_host = -1;
               SDB_ptr -> SDB.foreign_socket = -1;
	     return;
               end;

          if SDB_ptr -> SDB.local_pin = -1
          then do;
               if SDB_ptr -> SDB.connection_mode = ICP
               then SDB_ptr -> SDB.num_pins_allocated = 4;
               else SDB_ptr -> SDB.num_pins_allocated = 2;

               call net_pin_manager_$allocate_pins (SDB_ptr -> SDB.num_pins_allocated,
                         SDB_ptr -> SDB.local_pin, P_error_code);
               if P_error_code ^= 0
               then call attach_abort (P_error_code, IOSIM, "Unable to allocate local pin (^a).", device);
               end;

	return;

end;	/* end interpret_connection_mode	         */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

process_argument:
          procedure (p_control_arg, p_arg_indx);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (p_arg_indx fixed binary (17),
          p_control_arg character (*) varying)
               parameter;

	/* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
	local_pin_in_device fixed binary (8)
	     automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if p_control_arg = ""
          then return;

	if substr (p_control_arg, 1, 1) ^= "-"
	then do;
	     if device_description ^= ""
	     then call attach_abort (error_table_$wrong_no_of_args, IOSIM, "Only one device specification may be given.");

               device_description = P_attach_args (p_arg_indx);       /* get a copy of the device name        */
               if (device_description = "") | (device_description ^= P_attach_args (p_arg_indx))
               then call attach_abort (error_table_$bad_arg, IOSIM, "^a ^a", IOCB.name, device_description);

               call interpret_socket_spec_ ((device_description), SDB_ptr -> SDB.foreign_host, SDB_ptr -> SDB.foreign_socket,
                         local_pin_in_device, P_error_code);
               if P_error_code ^= 0
               then call attach_abort (P_error_code, IOSIM, "bad device specification (^a) for ^a.", device_description, IOCB.name);

	     if local_pin_in_device ^= -1
	     then call attach_abort (error_table_$invalid_device, IOSIM, device_description);

               if (SDB_ptr -> SDB.foreign_host = 0) & (SDB_ptr -> SDB.foreign_socket = 0)
               then SDB_ptr -> SDB.foreign_host, SDB_ptr -> SDB.foreign_socket = -1;

	     return;
	     end;

          if p_control_arg = "-connect"
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_attach_args, 1)
               then call attach_abort (error_table_$noarg, IOSIM, "No connection type specified with -connect.");

               if SDB_ptr -> SDB.connection_mode ^= UNSPECIFIED
               then call attach_abort (error_table_$wrong_no_of_args, IOSIM, "Only one specification of -connect may be given.");

               if P_attach_args (p_arg_indx) = "initiate"
               then SDB_ptr -> SDB.connection_mode = INITIATE;
               else if P_attach_args (p_arg_indx) = "listen"
                    then SDB_ptr -> SDB.connection_mode = LISTEN;
                    else if P_attach_args (p_arg_indx) = "icp"
                         then SDB_ptr -> SDB.connection_mode = ICP;
		     else if P_attach_args (p_arg_indx) = "passoff" | (P_attach_args (p_arg_indx) = "none")
			then SDB_ptr -> SDB.connection_mode = PASSOFF;
                              else call attach_abort (error_table_$bad_arg, IOSIM, "Valid args to -connect are:  initiate, connect, icp.");

               control_args_description = control_args_description || " -connect ";
               control_args_description = control_args_description || P_attach_args (p_arg_indx);

               return;
               end;

          if p_control_arg = "-local_pin"
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_attach_args, 1)
               then call attach_abort (error_table_$wrong_no_of_args, IOSIM, "No pin specified with -local_pin.");

               SDB_ptr -> SDB.local_pin = cv_dec_check_ ((P_attach_args (p_arg_indx)), err_code);
               if err_code ^= 0
               then call attach_abort (error_table_$bad_arg, IOSIM, "Arg to -local_pin is not a decimal integer:  ^a", P_attach_args (p_arg_indx));

               if (SDB_ptr -> SDB.local_pin < 0) | (SDB_ptr -> SDB.local_pin > 255)
               then call attach_abort (error_table_$bad_arg, IOSIM, "A pin number must be in the range 0 to 255.");

               control_args_description = control_args_description || " -local_pin ";
               control_args_description = control_args_description || P_attach_args (p_arg_indx);

               return;
               end;

          if (p_control_arg = "-userid") | (p_control_arg = "-socket_group") | (p_control_arg = "-sg")
          then do;
               p_arg_indx = p_arg_indx + 1;
               if p_arg_indx > hbound (P_attach_args, 1)
               then call attach_abort (error_table_$wrong_no_of_args, IOSIM, "No userid specified with -userid.");

               SDB_ptr -> SDB.userid = cv_dec_check_ ((P_attach_args (p_arg_indx)), err_code);
               if err_code ^= 0
               then call attach_abort (error_table_$bad_arg, IOSIM, "Arg to -userid is not a decimal integer:  ^a", P_attach_args (p_arg_indx));

               if (SDB_ptr -> SDB.userid < 0) | (SDB_ptr -> SDB.userid >= 2 ** 24)
               then call attach_abort (error_table_$bad_arg, IOSIM, "A userid must be in the range 0 to 2 ** 24 - 1.");

               control_args_description = control_args_description || " -userid ";
               control_args_description = control_args_description || P_attach_args (p_arg_indx);

               return;
               end;

          call attach_abort (error_table_$badopt, IOSIM, P_attach_args (p_arg_indx));

end;      /* end process_argument                          */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_data_transfer_                        */
end;




		    net_data_transfer_io_.pl1       09/23/77  1034.5rew 09/22/77  1725.3      225846



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

net_data_transfer_io_:
          procedure;

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          ((P_nelem, P_nelemt) fixed binary (24),
          P_error_code fixed binary (35),
          (P_IOCB_ptr, P_wksp_ptr) pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (this_byte_size fixed binary (8),
          (block_header_size, bytes_sent) fixed binary (24),
          (bytes_to_send, max_in_record, record_size) fixed binary (24),
          indx fixed binary (24),
          bytes_transmitted fixed binary (24),
          bytes_to_transmit fixed binary (24),
          err_code fixed binary (35),
          connection_closed bit (1),
          temp_byte bit (255) aligned,
          header_buffer bit (256) aligned,
          wksp_ptr pointer)
               automatic;

          /* * * * * DEFINED REFERENCES  * * * * * * * * * */

     declare
          1 IOCB aligned like iocb_template defined (P_IOCB_ptr -> iocb_template.actual_iocb_ptr -> iocb_template),
          1 SDB aligned like SDB_template defined (P_IOCB_ptr -> iocb_template.actual_iocb_ptr -> iocb_template.attach_data_ptr -> SDB_template);

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
         (based_bit_array (0 : 1) bit (1),
          based_bit_string bit (2359296))
               based;

     declare
          1 based_workspace unaligned based,
             2 byte (0 : 1) bit (SDB.byte_size) unaligned;

          /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */

     declare
         (error_table_$end_of_info,
          error_table_$illegal_record_size,
          error_table_$net_invalid_state)
               fixed binary (35) external static;

          /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */

     declare
          ipc_$block constant entry (ptr, ptr, fixed bin (35)),
          net_$ncp_read constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35)),
          net_$ncp_write constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35));

     declare
          (addr, binary, bit, copy, dimension, divide, length, min, null, substr)
               builtin;

	/* * * * * STACK REFERENCES  * * * * * * * * * * */

     declare
	this_is_a_restart_marker_
	     condition;

          /* * * * * INCLUDE FILES * * * * * * * * * * * * */

          % include net_data_transfer_dcls;
          % include net_event_template;
          % include net_iocb_template_dcls;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

return_to_caller:
          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_put_chars:
          entry (P_IOCB_ptr, P_wksp_ptr, P_nelem, P_error_code);

          P_error_code = 0;
          this_byte_size = SDB.byte_size;

          bytes_transmitted = 0;

          bytes_to_send = P_nelem;
          goto write_data (SDB.xfer_mode);

                    /* * * * * * * * * * * * * * * * * * * */

write_data (1):                                   /* Stream data                                    */
          wksp_ptr = P_wksp_ptr;

          call write_to_NCP (wksp_ptr, bytes_to_send, err_code);
          if err_code ^= 0
          then do;
               P_error_code = err_code;
               return;
               end;
          bytes_transmitted = bytes_transmitted + bytes_to_send;

          return;

                    /* * * * * * * * * * * * * * * * * * * */

write_data (2):                                   /* Block data                                     */
          block_header_size = this_byte_size * divide (24 + this_byte_size - 1, this_byte_size, 24, 0);

          bytes_sent = 0;

          do while (bytes_to_send > 0);
               record_size = min (bytes_to_send, 65535);

               header_buffer = ""b;
               substr (header_buffer, block_header_size - 24 + 1, 24) = "00000000"b || bit (binary (record_size, 16));

               call write_to_NCP (addr (header_buffer), divide (block_header_size, this_byte_size, 24, 0), err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_sent));
               call write_to_NCP (wksp_ptr, record_size, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               bytes_sent = bytes_sent + record_size;
               bytes_to_send = bytes_to_send - record_size;

               bytes_transmitted = bytes_transmitted + record_size;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

write_data (3):                                   /* Compressed Data                                */
          max_in_record = 2 ** min (this_byte_size - 1, 23) - 1;      /* what is max we will put in record    */

          bytes_sent = 0;

          do while (bytes_to_send > 0);
               record_size = min (max_in_record, bytes_to_send);

               header_buffer = ""b;
               substr (header_buffer, length (header_buffer) - 24 + 1, 24) = bit (binary (record_size, 24));
                                                            /* get a long string representation of the size;  */
                                                            /* notice that it fits in proper size because of  */
                                                            /* all the maxs done on record_size               */

                                                                      /* record_size                          */
               temp_byte = substr (header_buffer, length (header_buffer) - this_byte_size + 1, this_byte_size);
               call write_to_NCP (addr (temp_byte), 1, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_sent));
               call write_to_NCP (wksp_ptr, record_size, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               bytes_sent = bytes_sent + record_size;
               bytes_to_send = bytes_to_send - record_size;

               bytes_transmitted = bytes_transmitted + record_size;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_get_chars:
          entry (P_IOCB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_error_code);

          P_error_code = 0;

          this_byte_size = SDB.byte_size;

          bytes_transmitted = 0;
          bytes_to_transmit = P_nelem;
          P_nelemt = bytes_transmitted;
          connection_closed = "0"b;

          goto read_data (SDB.xfer_mode);

                    /* * * * * * * * * * * * * * * * * * */

read_data (1):                                    /* Stream data                                    */
          do while (bytes_transmitted < bytes_to_transmit);
               wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_transmitted));

               call read_from_NCP (wksp_ptr, P_nelem - bytes_transmitted, bytes_sent, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               bytes_transmitted = bytes_transmitted + bytes_sent;
               P_nelemt = bytes_transmitted;

               if connection_closed
               then do;
                    P_error_code = error_table_$end_of_info;
                    return;
                    end;

               if bytes_sent = 0
               then if (bytes_transmitted = 0) | (^ SDB.allow_partial_reads)
                    then call block (SDB.read_connection.event_channel);
                    else return;

               end;

          return;

                    /* * * * * * * * * * * * * * * * * * */

read_data (2):                                    /* Block data                                     */
          block_header_size = this_byte_size * divide (24 + this_byte_size - 1, this_byte_size, 24, 0);

          bytes_sent = 0;

          do while (bytes_transmitted < bytes_to_transmit);
               wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_transmitted));

               if SDB.blocking.block_bytes_left = 0
               then do;
                    do indx = 0 by 1 to divide (block_header_size, this_byte_size, 24, 0) - 1;
                         call read_from_NCP (addr (temp_byte), 1, (0), err_code);
                         if err_code ^= 0
                         then do;
                              P_error_code = err_code;
                              return;
                              end;

                         substr (header_buffer, 1 + (indx * this_byte_size), this_byte_size) = substr (temp_byte, 1, this_byte_size);
                         end;

                    SDB.blocking.descriptor_byte = substr (header_buffer, block_header_size - 24 + 1, 8);
                    SDB.blocking.block_bytes_left = binary (substr (header_buffer, block_header_size - 16 + 1, 16), 16);
/*                  if restart then read one by one         */
                    end;

               record_size = min (SDB.blocking.block_bytes_left, bytes_to_transmit - bytes_transmitted);
               call read_from_NCP (wksp_ptr, record_size, bytes_sent, err_code);
               if err_code ^= 0
               then do;
                    P_error_code = err_code;
                    return;
                    end;

               SDB.blocking.block_bytes_left = SDB.blocking.block_bytes_left - bytes_sent;

               if SDB.blocking.block_bytes_left = 0
               then do;
                    if substr (SDB.blocking.descriptor_byte, 2, 1)
                    then;                                   /* no way to indicate this is end of record       */

                    if substr (SDB.blocking.descriptor_byte, 3, 1)
                    then P_error_code = error_table_$end_of_info;     /* end of file                          */

                    if substr (SDB.blocking.descriptor_byte, 5, 1)
                    then signal this_is_a_restart_marker_;

                    if substr (SDB.blocking.descriptor_byte, 1, this_byte_size) ^= ""b
                    then return;
                    end;

               P_nelemt = bytes_transmitted;

               if bytes_sent = 0
               then if (bytes_transmitted = 0) | (^ SDB.allow_partial_reads)
                    then call block (SDB.read_connection.event_channel);
                    else return;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

read_data (3):                                    /* Compressed Data                                */
          do while (bytes_transmitted < bytes_to_transmit);
               if (SDB.blocking.block_bytes_left = 0) & (SDB.blocking.replication = 0)
               then do;                                     /* next item in must be a string descriptor       */
                    call read_from_NCP (addr (temp_byte), 1, (0), err_code);
                    if err_code ^= 0
                    then do;
                         P_error_code = err_code;
                         return;
                         end;

                    if substr (temp_byte, 1, this_byte_size) = ""b
                    then do;                                /* we have a descriptor byte coming up            */
                         call read_from_NCP (addr (SDB.blocking.descriptor_byte), 1, (0), err_code);
                         if err_code ^= 0
                         then do;
                              P_error_code = err_code;
                              return;
                              end;

                         call read_from_NCP (addr (temp_byte), 1, (0), err_code);    /* we need a descriptor again */
                         if err_code ^= 0
                         then do;
                              P_error_code = err_code;
                              return;
                              end;
                         end;
                    else SDB.blocking.descriptor_byte = ""b;     /* all bets are off on old descriptors  */

                    if substr (temp_byte, 1, 1) = "0"b
                    then do;                                /* this is a count for regular data               */
                         SDB.blocking.block_bytes_left = convert_to_number (temp_byte);
                         end;
                    else if substr (temp_byte, 1, 2) = "10"b
                         then do;                           /* this is a count of n replications of next byte */
                              substr (temp_byte, 1, 2) ="00"b;        /* make an actual number representation */
                              SDB.blocking.replication = convert_to_number (temp_byte);

                              call read_from_NCP (addr (SDB.blocking.replication_byte), 1, (0), err_code);
                              if err_code ^= 0
                              then do;
                                   P_error_code = err_code;
                                   return;
                                   end;
                              end;
                         else do;
                              substr (temp_byte, 1, 2) = "00"b;
                              SDB.blocking.replication = convert_to_number (temp_byte);
                              SDB.blocking.replication_byte = SDB.parameters.filler_byte;
                              end;
                    end;
               wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_transmitted));

               if SDB.blocking.block_bytes_left ^= 0
               then do;
                    record_size = min (SDB.blocking.block_bytes_left, bytes_to_transmit - bytes_transmitted);

                    call read_from_NCP (wksp_ptr, record_size, bytes_sent, err_code);
                    if err_code ^= 0
                    then do;
                         P_error_code = err_code;
                         return;
                         end;

                    SDB.blocking.block_bytes_left = SDB.blocking.block_bytes_left - bytes_sent;
                    bytes_transmitted = bytes_transmitted + bytes_sent;
                    end;

               if SDB.blocking.replication ^= 0
               then do;
                    record_size = min (SDB.blocking.replication, P_nelem - bytes_transmitted);

                    wksp_ptr = addr (P_wksp_ptr -> based_workspace.byte (bytes_transmitted));

                    substr (wksp_ptr -> based_bit_string, 1, record_size * this_byte_size)
                              = copy (substr (SDB.blocking.replication_byte, 1, this_byte_size), record_size);

                    SDB.blocking.replication = SDB.blocking.replication - record_size;
                    bytes_transmitted = bytes_transmitted + record_size;
                    end;

               if SDB.blocking.block_bytes_left = 0 & (SDB.blocking.replication = 0)
               then do;
                    end;

               P_nelemt = bytes_transmitted;

               if bytes_sent = 0
               then if (bytes_transmitted = 0) | (^ SDB.allow_partial_reads)
                    then call block (SDB.read_connection.event_channel);
                    else return;
               end;

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

net_data_xfer_put_chars_straight:
          entry (P_IOCB_ptr, P_wksp_ptr, P_nelem, P_error_code);

          P_error_code = 0;
          this_byte_size = SDB.byte_size;


          wksp_ptr = P_wksp_ptr;

          call write_to_NCP (wksp_ptr, P_nelem , P_error_code);

          return;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

ndt_fill_static_buffer:
          entry (P_IOCB_ptr, P_error_code);

          this_byte_size = SDB.byte_size;

          call read_from_NCP (null (), 0, (0), P_error_code);

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

write_to_NCP:
          procedure (P_data_ptr, P_data_bytes, P_error_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * * */

     declare
         (P_data_bytes fixed binary (24),
          P_error_code fixed binary (35),
          P_data_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (connection_state fixed binary (6),
          (num_bits_sent, num_bytes_to_send, num_transmitted) fixed binary (24))
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          num_bytes_to_send = P_data_bytes;
          num_bits_sent = 0;

          do while (num_bytes_to_send > 0);
               call net_$ncp_write (SDB.write_connection.ncp_indx, addr (P_data_ptr -> based_bit_array (num_bits_sent)),
                         num_bytes_to_send, num_transmitted, connection_state, P_error_code);
               num_bytes_to_send = num_bytes_to_send - num_transmitted;

               num_bits_sent = num_bits_sent + num_transmitted * this_byte_size;

               if P_error_code ^= 0
               then return;

               if connection_state ^= 6
               then do;
                    P_error_code = error_table_$net_invalid_state;
                    return;
                    end;

               if num_bytes_to_send > 0
               then call block (SDB.write_connection.event_channel);
               end;

          P_error_code = 0;

          return;

end;      /* end write_to_NCP                              */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

read_from_NCP:
          procedure (P_data_ptr, P_bytes_to_read, P_bytes_read, P_error_code);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         ((P_bytes_read, P_bytes_to_read) fixed binary (24),
          P_error_code fixed binary (35),
          P_data_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
         (connection_state fixed binary (6),
          num_bytes_in_imp_message fixed binary (24),
          num_transmitted fixed binary (24),
          something_happened bit (1) aligned)
               automatic;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          P_error_code = 0;

          P_bytes_read = 0;

          if SDB.xfer_buffer.num_bits ^= 0
          then do;
               num_transmitted = copy_bits (P_data_ptr, P_bytes_to_read * this_byte_size);

               P_bytes_read = divide (num_transmitted, this_byte_size, 24, 0);

               return;
               end;

          SDB.xfer_buffer.bit_offset = 0;

          if (P_bytes_to_read * this_byte_size) < dimension (SDB.xfer_buffer.byte, 1)
          then do;
               num_bytes_in_imp_message = divide (dimension (SDB.xfer_buffer.byte, 1), this_byte_size, 24, 0);
               something_happened = info_from_hc (addr (SDB.xfer_buffer.byte (0)), num_bytes_in_imp_message, num_transmitted);
               SDB.xfer_buffer.num_bits = SDB.xfer_buffer.num_bits + num_transmitted * this_byte_size;

               if ^ something_happened
               then return;

               num_transmitted = copy_bits (P_data_ptr, P_bytes_to_read * this_byte_size);

               P_bytes_read = divide (num_transmitted, this_byte_size, 24, 0);

               return;
               end;

          if ^ info_from_hc (P_data_ptr, P_bytes_to_read, P_bytes_read)
          then return;

          return;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

info_from_hc:
          procedure (P_read_ptr, P_num_bytes, P_num_bytes_read) returns (bit (1) aligned);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_num_bytes fixed binary (24),
          P_num_bytes_read fixed binary (24),
          P_read_ptr pointer)
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          call net_$ncp_read (SDB.read_connection.ncp_indx, P_read_ptr, P_num_bytes, P_num_bytes_read,
                    connection_state, P_error_code);
          if P_error_code ^= 0
          then do;
               if (SDB.xfer_mode = 1) & (P_error_code = error_table_$net_invalid_state)
               then do;                                     /* in stream mode, this is a close (end of file)  */
                    connection_closed = "1"b;
                    P_error_code = 0;
                    end;
               end;

          if P_error_code ^= 0
          then return ("1"b);

          if connection_closed
          then return ("1"b);

          if P_num_bytes_read ^= 0
          then return ("1"b);

          return ("0"b);

end;      /* end info_from_hc                              */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

copy_bits:
          procedure (P_to_ptr, P_bit_count) returns (fixed bin (24));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
         (P_bit_count fixed binary (24),
          P_to_ptr pointer)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          num_to_copy fixed binary (24)
               automatic;

          /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */

     declare
          based_bit_string bit (num_to_copy)
               based;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if (P_to_ptr = null ()) | (P_bit_count = 0)
          then return (0);

          num_to_copy = min (P_bit_count, SDB.xfer_buffer.num_bits);
          num_to_copy = this_byte_size * divide (num_to_copy, this_byte_size, 24, 0);

          P_to_ptr -> based_bit_string = addr (SDB.xfer_buffer.byte (SDB.xfer_buffer.bit_offset)) -> based_bit_string;

          SDB.xfer_buffer.num_bits = SDB.xfer_buffer.num_bits - num_to_copy;
          SDB.xfer_buffer.bit_offset = SDB.xfer_buffer.bit_offset + num_to_copy;

          return (num_to_copy);

end;      /* end copy_bits                                 */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

end;      /* end read_from_NCP                             */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

block:
          procedure (P_event_channel);

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_event_channel fixed binary (71)
               parameter;

          /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */

     declare
          1 event_list aligned automatic,
             2 num_channels fixed binary (17),
             2 event_channel fixed binary (71);

     declare
          1 event_message aligned automatic like event_message_template;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          event_list.num_channels = 1;
          event_list.event_channel = P_event_channel;

          call ipc_$block (addr (event_list), addr (event_message), err_code);

          return;

end;      /* end block                                     */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

convert_to_number:
          procedure (P_input_byte) returns (fixed bin (35));

          /* * * * * PARAMETER DECLARATIONS  * * * * * * * */

     declare
          P_input_byte bit (255) aligned
               parameter;

          /* * * * * * * * * * * * * * * * * * * * * * * * */

          if this_byte_size <= 35
          then return (binary (substr (P_input_byte, 1, this_byte_size), 35));

          if substr (P_input_byte, 1, this_byte_size - 24) ^= ""b
          then do;
               P_error_code = error_table_$illegal_record_size;
               goto return_to_caller;
               end;

          return (binary (substr (P_input_byte, this_byte_size - 24 + 1, 24), 35));

end;      /* end convert_to_number                         */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

          /* end net_data_transfer_io_                     */
end;





		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
