PACKET free channel DEFINES                       (* Autor: J.Liedtke *)
                                                  (* Stand: 05.10.82  *)
  FCHANNEL ,
  := ,
  free channel ,
  open ,
  close ,
  out ,
  in ,
  dialogue :
 
 

LET ack                = 0 ,
    nak                = 1 ,
    break code         = 6 ,
    empty message code = 256 ,
    long message code  = 257 ,
    file message code  = 1024 ,
    open code          = 1000 ,
    close code         = 1001 ,

    cr                 = ""13"" ;

INT CONST task not existing := - 1 ;


TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ;

INT VAR message code , response code ;
TASK VAR partner , used by ;
DATASPACE VAR ds ;

BOUND TEXT VAR msg ;
TEXT VAR response, char, esc char , record ;

FILE VAR file ;


OP := (FCHANNEL VAR dest, FCHANNEL CONST source) :
 
  dest.server := source.server ;
  dest.input buffer := "" ;
  dest.server name := source.server name ;
  open (dest)

ENDOP := ;

FCHANNEL PROC free channel (TEXT CONST channel name) :

  FCHANNEL:(niltask,"", channel name)

ENDPROC free channel ;

PROC open (FCHANNEL VAR channel) :

  TASK VAR task id ;
  INT VAR receipt ;
 
  initialize message dataspace ;
  send open code ;
  IF receipt <> ack
    THEN errorstop ("channel not free")
  FI .

initialize message dataspace :
  forget (ds) ;
  ds := nilspace .

send open code :
  ping pong (channel.server, open code, ds, receipt) ;
  IF receipt = task not existing
    THEN channel.server := task (channel.server name) ;
         ping pong (channel.server, open code, ds, receipt)
  FI .
 
ENDPROC open ;

PROC close (FCHANNEL VAR channel) :

  call (channel.server, close code, ds, response code)

ENDPROC close ;

PROC close (TEXT CONST channel server) :

  call (task (channel server), close code, ds, response code)

ENDPROC close ;


PROC out (FCHANNEL VAR channel, TEXT CONST message) :

  send message ;
  get response .

send message :
  IF message = ""
    THEN call (channel.server, empty message code, ds, response code)
    ELSE msg := ds ;
         CONCR (msg) := message ;
         call (channel.server, long message code, ds, response code)
  FI .

get response :
  IF response code < 0
    THEN errorstop ("channel not ready")
  ELIF response code < 256
    THEN channel.input buffer CAT code (response code)
  ELIF response code = long message code
    THEN msg := ds ;
         channel.input buffer CAT CONCR (msg)
  FI .

ENDPROC out ;

PROC in (FCHANNEL VAR channel, TEXT VAR response) :

  out (channel, "") ;
  response := channel.input buffer ;
  channel.input buffer := ""

ENDPROC in ;

PROC out (FCHANNEL VAR channel, DATASPACE CONST file space) :

  out (channel, file space, ""0"")

ENDPROC out ;

PROC out (FCHANNEL VAR channel, DATASPACE CONST file space,
          TEXT CONST handshake char) :

  forget (ds) ;
  ds := file space ;
  call (channel.server, file message code + code (handshake char) ,
                        ds, response code) ;
  forget (ds) ;
  ds := nilspace

ENDPROC out ;


PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) :

  forget (ds) ;
  ds := nilspace ;
  partner := channel.server ;
  esc char := esc ;
  enable stop ;

  response code := empty message code ;
  REP
    get and send message charety ;
    out response option
  PER .

get and send message charety :
  IF response code = empty message code
    THEN char := incharety (10)
    ELSE char := incharety
  FI ;
  IF char = ""
    THEN call (partner, empty message code, ds, response code)
  ELIF char = esc char
    THEN LEAVE dialogue
  ELSE   call (partner, code (char), ds, response code)
  FI .

out response option :
  IF response code < 256
    THEN out (code (response code))
  ELIF response code = long message code
    THEN msg := ds ;
         out (CONCR (msg))
  FI .

ENDPROC dialogue ;

PROC free channel (INT CONST nr) :

  INT CONST my channel := nr ;
  break ;
  disable stop ;
  REP
    wait (ds, message code, partner) ;
    IF message code = open code
      THEN connect to my channel ;
           use channel ;
           break without advertise ;
           send handshake ack 
      ELSE send (partner, nak, ds)
    FI
  PER .

use channel :
  ping pong (partner, ack, ds, message code) ;
  REP
    execute message ;
    response option
  PER .

execute message :
  IF   message code < 0
    THEN LEAVE use channel
  ELIF message code < 256
    THEN out (code (message code))
  ELIF message code = long message code
    THEN msg := ds ;
         out (CONCR (msg))
  ELIF message code >= file message code
    THEN send file ;
         clear error
  ELIF message code = close code
    THEN LEAVE use channel
  FI .

response option :
  response := incharety (1) ;
  IF response = ""
    THEN ping pong (partner, empty message code, ds, message code)
    ELSE short or long response
  FI .

short or long response :
  char := incharety ;
  IF char = ""
    THEN short response
    ELSE long response
  FI .

short response :
  ping pong (partner, code (response), ds, message code) .

long response :
  msg := ds ;
  response CAT char ;
  REP
    char := incharety ;
    response CAT char
  UNTIL char = "" PER ;
  CONCR (msg) := response ;
  ping pong (partner, long message code, ds, message code) .

connect to my channel :
  continue (my channel) ;
  WHILE is error REP
    clear error ;
    pause (100) ;
    continue (my channel)
  PER .

break without advertise :
  INT VAR receipt ;
  call (supervisor, break code, ds, receipt) .

send handshake ack :
  send (partner, ack, ds) .

ENDPROC free channel ;

PROC send file :

  enable stop ;
  get handshake ;
  file := sequential file (input,ds) ;
  REP
    getline (file, record) ;
    out (record) ;
    out (cr) ;
    handshake option
  UNTIL eof (file) PER .

get handshake :
  TEXT CONST handshake char := code (message code - file message code) .

handshake option :
  IF handshake char <> ""0""
    THEN wait for handshake or time out
  FI .

wait for handshake or time out :
  REP
    char := incharety (300)
  UNTIL char = handshake char OR char = "" PER ;
  IF char = ""
    THEN LEAVE send file
  FI .

ENDPROC send file ;

ENDPACKET free channel ;