! TCP and UDP interface module for VMS, GDMR, April/June 1987
! Use QIO throughout rather than QIOW to avoid deadlocks.  We're not
! really interested in the IOSB anyway!!

%constinteger TCP0 read efn = 41
%constinteger TCP0      efn = 42
%constinteger UDP0 read efn = 43
%constinteger UDP0      efn = 44

%owninteger TCP0 channel = 0
%owninteger UDP0 channel = 0


! TCP interface

%routine start TCP0 read
   %externalintegerspec AST routine %alias "INET__TCP0_AST_ROUTINE"
   %record(buffer fm)%name buffer
   %integer status
      buffer == claim buffer
      buffer_data start == buffer_data(64)
      status = QIO(TCP0 read efn, TCP0 channel, IO readvblk, buffer_IOSB,
                   addr(AST routine), addr(buffer),
                   addr(buffer_data start), 1024, 0, 0, 0, 0)
      %signal 15, status %if status & 1 = 0
%end

%externalroutine TCP0 AST routine %alias "INET__TCP0_AST_ROUTINE" %c
                                  (%record(buffer fm)%name b)
   enqueue buffer(b, TCP outbound queue)
   start TCP0 read
   wake(0, 0)
%end

%predicate TCP send to user(%record(buffer fm)%name b)
   %externalintegerspec AST routine %alias "INET__TCP0_SEND_AST_ROUTINE"
   %integer status
      !! printstring("TCP send to user ");  write(b_tag, 0);  space
      !! write(b_data bytes, 0);  newline
      %signal 13, b_TCB_slot %unless 0 < b_TCB_slot <= max TCP
      status = QIO(TCP0 efn, TCP0 channel, IO writevblk, b_IOSB,
                   addr(AST routine), addr(b),
                   addr(b_data start), b_data bytes, 0, 0, 0, b_TCB_slot)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP send fails ");  phex(status);  newline
         release buffer(b)
         %false
      %finish
      %true
%end

%externalroutine TCP0 send AST routine %alias "INET__TCP0_SEND_AST_ROUTINE" %c
                                       (%record(buffer fm)%name b)
   %if b_IOSB_status & 1 = 0 %start
      !! pdate
      !! printstring("Send fails ");  phex(b_IOSB_status);  newline
      release buffer(b)
   %else %if b_next queue == nil
      release buffer(b)
   %else
      enqueue buffer(b, b_next queue)
      wake(0, 0)
   %finish
%end

%routine TCP send close(%integer unit)
   ! We don't bother with an IOSB here.  We assume that if the WritEOF
   ! was successfully enqueued then the only thing that can prevent it
   ! being delivered is if the other side goes away; in that case, the
   ! connection will be zapped anyway...
   %integer status
      !! printstring("TCP send close: ");  write(unit, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      status = QIO(TCP0 efn, TCP0 channel, IO writeof, nil, 0, 0,
                   0, 0, 0, 0, 0, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP close fails ");  phex(status);  newline
      %finish
%end

%routine TCP open response(%integer unit, error, ra, rp, lp)
   %recordformat connect fm(%integer ra, rp, lp)
   %record(connect fm) c
   %integer status, code
      !! printstring("TCP send open response: ");  write(unit, 0)
      !! space;  phex(error);  space;  phex(ra)
      !! space;  write(rp, 0);  space;  write(lp, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      c_ra = ra;  c_rp = rp;  c_lp = lp
      %if error = 0 %then code = IO create %c
                    %else code = IO create ! IOM abort
      status = QIO(TCP0 efn, TCP0 channel, code, nil, 0, 0,
                   addr(c), 12, 0, 0, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP open response fails ");  phex(status);  newline
      %finish
%end

%routine TCP claim response(%integer unit, error, allocated)
   %integer status, code
      !! printstring("TCP claim response: ");  write(unit, 0)
      !! space;  phex(error);  space;  write(allocated, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      %if error = 0 %then code = IO readprompt %c
                    %else code = IO readprompt ! IOM abort
      status = QIO(TCP0 efn, TCP0 channel, code, nil, 0, 0,
                   0, 0, 0, allocated, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP claim response fails ");  phex(status);  newline
      %finish
%end

%routine TCP enable(%integer unit)
   %integer status
      !! printstring("TCP enable ");  write(unit, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      status = QIO(TCP0 efn, TCP0 channel, IO setmode ! IOM mount, nil, 0, 0,
                   0, 0, 0, 0, 0, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP enable fails ");  phex(status);  newline
      %finish
%end

%routine TCP disable(%integer unit, error)
   %integer status, code
      !! printstring("TCP disable ");  write(unit, 0);  space
      !! phex(error);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      %if error > 0 %then code = IO setmode ! IOM dmount ! IOM abort %c
                    %else code = IO setmode ! IOM dmount
      status = QIO(TCP0 efn, TCP0 channel, code, nil, 0, 0,
                   0, 0, 0, 0, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP disable fails ");  phex(status);  newline
      %finish
%end

%routine TCP block(%integer unit)
   %integer status
      !! printstring("TCP block ");  write(unit, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      status = QIO(TCP0 efn, TCP0 channel,
                   IO setmode ! IOM dmount ! IOM qualified,
                   nil, 0, 0, 0, 0, 0, 0, 0, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP block fails ");  phex(status);  newline
      %finish
%end

%routine TCP unblock(%integer unit)
   %integer status
      !! printstring("TCP unblock ");  write(unit, 0);  newline
      %signal 13, unit %unless 0 < unit <= max TCP
      status = QIO(TCP0 efn, TCP0 channel,
                   IO setmode ! IOM mount ! IOM qualified,
                   nil, 0, 0, 0, 0, 0, 0, 0, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue TCP unblock fails ");  phex(status);  newline
      %finish
%end

%constinteger TCP open        request = 1
%constinteger TCP send        request = 2
%constinteger TCP close       request = 3
%constinteger TCP abort       request = 4
%constinteger TCP claim       request = 5
%constinteger TCP claim priv  request = 6

%predicate TCP interpret user request(%record(buffer fm)%name b)
   ! Convert from driver code/status to internally acceptable form
   ! False if we don't like the buffer (our caller will get rid of it)
   %integer unit, func
      !! printstring("TCP interpret request: ")
      !! phex(b_IOSB_unit);  space;  phex(b_IOSB_status);  space
      !! write(b_IOSB_length, 0);  space;  phex(b_IOSB_func);  newline
      %if b_IOSB_status = SS endoffile %start
         b_code = TCP close request
      %else %if b_IOSB_status = SS hangup
         b_code = TCP abort request
      %else %if b_IOSB_status & 1 = 0
         !! pdate
         !! printstring("TCP0: ");  phex(b_IOSB_status);  newline
         %false
      %else
         func = b_IOSB_func & 16_3F
         %if func = IO writepblk %start
            b_code = TCP send request
         %else %if func = IO create
            b_code = TCP open request
            b_privilege = b_IOSB_unit & 16_8000
         %else %if func = IO readprompt
            %if b_IOSB_func & IOM qualified = 0 %start
               b_code = TCP claim request
            %else
               b_code = TCP claim priv request
            %finish
            b_privilege = b_IOSB_unit & 16_8000
         %else
            %false
         %finish
      %finish
      unit = b_IOSB_unit & 16_7FFF
      %signal 13, unit %unless 0 < unit <= max TCP;  ! Dud unit, disaster
      b_TCB == TCB table_TCB(unit)
      b_TCB_slot = unit
      b_data bytes = b_IOSB_length
      %true
%end


! UDP interface

%routine start UDP0 read
   %externalintegerspec AST routine %alias "INET__UDP0_AST_ROUTINE"
   %record(buffer fm)%name buffer
   %integer status
      buffer == claim buffer
      buffer_data start == buffer_data(64)
      status = QIO(UDP0 read efn, UDP0 channel, IO readvblk, buffer_IOSB,
                   addr(AST routine), addr(buffer),
                   addr(buffer_data start), 1024, 0, 0, 0, 0)
      %signal 15, status %if status & 1 = 0
%end

%externalroutine UDP0 AST routine %alias "INET__UDP0_AST_ROUTINE" %c
                                  (%record(buffer fm)%name b)
   enqueue buffer(b, UDP outbound queue)
   start UDP0 read
   wake(0, 0)
%end

%routine UDP send to user(%record(buffer fm)%name b)
   %integer status
      !! printstring("UDP send to user ");  write(b_data bytes, 0);  newline
      %signal 13, b_UDP entry_slot %unless 0 < b_UDP entry_slot <= max UDP
      status = QIO(UDP0 efn, UDP0 channel, IO writevblk, nil, 0, 0,
                   addr(b_data start), b_data bytes, b_IP header_source,
                   0, 0, b_UDP entry_slot)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue UDP send fails ");  phex(status);  newline
      %finish
      ! Release the buffer unconditionally -- once the IO has been queued the
      ! driver has a copy of it so we don't need our copy any more.
      release buffer(b)
%end

%routine UDP open response(%integer unit, error, ra, rp, lp)
   %recordformat connect fm(%integer ra, rp, lp)
   %record(connect fm) c
   %integer status, code
      !! printstring("UDP send open response: ");  write(unit, 0)
      !! space;  phex(error);  space;  phex(ra)
      !! space;  write(rp, 0);  space;  write(lp, 0);  newline
      %signal 13, unit %unless 0 < unit <= max UDP
      c_ra = ra;  c_rp = rp;  c_lp = lp
      %if error = 0 %then code = IO create %c
                    %else code = IO create ! IOM abort
      status = QIO(UDP0 efn, UDP0 channel, code, nil, 0, 0,
                   addr(c), 12, 0, 0, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue UDP open response fails ");  phex(status);  newline
      %finish
%end

%routine UDP claim response(%integer unit, error, allocated)
   %integer status, code
      !! printstring("UDP claim response: ");  write(unit, 0)
      !! space;  phex(error);  space;  write(allocated, 0);  newline
      %signal 13, unit %unless 0 < unit <= max UDP
      %if error = 0 %then code = IO readprompt %c
                    %else code = IO readprompt ! IOM abort
      status = QIO(UDP0 efn, UDP0 channel, code, nil, 0, 0,
                   0, 0, 0, allocated, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue UDP claim response fails ");  phex(status);  newline
      %finish
%end

%routine UDP enable(%integer unit)
   %integer status
      !! printstring("UDP enable ");  write(unit, 0);  newline
      %signal 13, unit %unless 0 < unit <= max UDP
      status = QIO(UDP0 efn, UDP0 channel, IO setmode ! IOM mount, nil, 0, 0,
                   0, 0, 0, 0, 0, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue UDP enable fails ");  phex(status);  newline
      %finish
%end

%routine UDP disable(%integer unit, error)
   %integer status, code
      !! printstring("UDP disable ");  write(unit, 0);  space
      !! phex(error);  newline
      %signal 13, unit %unless 0 < unit <= max UDP
      %if error > 0 %then code = IO setmode ! IOM dmount ! IOM abort %c
                    %else code = IO setmode ! IOM dmount
      status = QIO(UDP0 efn, UDP0 channel, code, nil, 0, 0,
                   0, 0, 0, 0, error, unit)
      %if status & 1 = 0 %start
         pdate
         printstring("Enqueue UDP disable fails ");  phex(status);  newline
      %finish
%end

%constinteger UDP define context request = 1
%constinteger UDP forget context request = 2
%constinteger UDP query context  request = 3
%constinteger UDP data           request = 4
%constinteger UDP claim          request = 6
%constinteger UDP claim priv     request = 7

%predicate UDP interpret user request(%record(buffer fm)%name b)
   ! Convert from driver code/status to internally acceptable form
   ! False if we don't like the buffer (our caller will get rid of it)
   %integer unit, func
      !! printstring("UDP interpret request: ")
      !! phex(b_IOSB_unit);  space;  phex(b_IOSB_status);  space
      !! write(b_IOSB_length, 0);  space;  phex(b_IOSB_func);  newline
      %if b_IOSB_status = SS endoffile %c
            %or b_IOSB_status = SS hangup %start
         b_code = UDP forget context request
      %else %if b_IOSB_status & 1 = 0
         !! pdate
         !! printstring("UDP0: ");  phex(b_IOSB_status);  newline
         %false
      %else
         func = b_IOSB_func & 16_3F
         %if func = IO writepblk %start
            b_code = UDP data request
         %else %if func = IO create
            %if b_IOSB_func & IOM readCSR = 0 %start
               b_code = UDP define context request
            %else
               b_code = UDP query context request
            %finish
            b_privilege = b_IOSB_unit & 16_8000
         %else %if func = IO readprompt
            %if b_IOSB_func & IOM qualified = 0 %start
               b_code = UDP claim request
            %else
               b_code = UDP claim priv request
            %finish
            b_privilege = b_IOSB_unit & 16_8000
         %else
            %false
         %finish
      %finish
      unit = b_IOSB_unit & 16_7FFF
      %signal 13, unit %unless 0 < unit <= max UDP;  ! Dud unit, disaster
      b_UDP entry == UDP table_UDP(unit)
      b_UDP entry_slot = unit
      b_data bytes = b_IOSB_length
      %true
%end


! Initialisation

%routine start user interfaces(%integername max TCP0, max UDP0)
   %ownstring(7) TCP0 name = "_TCP0:"
   %ownstring(7) UDP0 name = "_UDP0:"
   %record(desc fm) d
   %record(IOSB fm) IOSB
   %integer status
      d_l = length(TCP0 name); d_a = addr(TCP0 name) + 1
      status = assign(d, TCP0 channel, 0, 0)
      %if status & 1 = 0 %start
         printstring("Failed to assign to ");  printstring(TCP0 name)
         printstring(" -- ");  printstring(sysmess(status));  newline
         max TCP0 = 0
      %else
         status = QIOW(TCP0 efn, TCP0 channel, IO sensemode, IOSB, 0, 0,
                       0, 0, 0, 0, 0, 0)
         %if status & 1 = 0 %start
            printstring("Failed to enqueue SenseMode to ")
            printstring(TCP0 name);  printstring(" -- ")
            printstring(sysmess(status));  newline
            max TCP0 = 0
         %else %if IOSB_status & 1 = 0
            printstring("SenseMode to ")
            printstring(TCP0 name);  printstring(" failed -- ")
            printstring(sysmess(IOSB_status));  newline
            max TCP0 = 0
         %else
            !! printstring("Channel ");  write(TCP0 channel, 0)
            !! printstring(" assigned to ");  printstring(TCP0 name);  newline
            max TCP0 = IOSB_unit - 1;  ! Discount master
            start TCP0 read
         %finish
      %finish
      d_l = length(UDP0 name); d_a = addr(UDP0 name) + 1
      status = assign(d, UDP0 channel, 0, 0)
      %if status & 1 = 0 %start
         printstring("Failed to assign to ");  printstring(UDP0 name)
         printstring(" -- ");  printstring(sysmess(status));  newline
         max UDP0 = 0
      %else
         status = QIOW(UDP0 efn, UDP0 channel, IO sensemode, IOSB, 0, 0,
                       0, 0, 0, 0, 0, 0)
         %if status & 1 = 0 %start
            printstring("Failed to enqueue SenseMode to ")
            printstring(UDP0 name);  printstring(" -- ")
            printstring(sysmess(status));  newline
            max UDP0 = 0
         %else %if IOSB_status & 1 = 0
            printstring("SenseMode to ")
            printstring(UDP0 name);  printstring(" failed -- ")
            printstring(sysmess(IOSB_status));  newline
            max UDP0 = 0
         %else
            max UDP0 = IOSB_unit - 1;  ! Discount master
            start UDP0 read
            !! printstring("Channel ");  write(UDP0 channel, 0)
            !! printstring(" assigned to ");  printstring(UDP0 name);  newline
         %finish
      %finish
%end

%end %of %file