!prep options
! x - uses ts interface
! default is the old bsp (gate) interface
!
#datestring
!Z80 TCP BOOT PROGRAM
!
!!  STK = 500,  STRM = 1
!
!VERSION 6 ALLOWS ALTERNATIVES IN THE PATTERN MATCH USING [..|..|..]
!VERSION 5 USES THE CALLING ADDRESS IN THE TSBSP OPEN IF PRESENT
!          INSTEAD OF DOING A REVERSE LOOKUP
!VERSION 4 READS A CONTROL FILE CONTAINING A LIST OF NAMES WITH
!          ASSOCIATED LOAD FILES.  WITHIN THE NAMES * MATCHES EVERYTHING
!          INT R ZBT CAUSES CONTROL FILE TO BE RESCANNED
!VERSION 3 ALLOWS INT A AND A TIMEOUT FOR STUCK LOADS
!VERSION 2 ALLOWS THE USER TO SPECIFY A MACHINE NAME AND CORRESPONDING
!         LOAD FILE - INT S ZBT PUTS IT INTO THE 'SET' MODE WHERE
!         IT PROMPTS FOR THE MACHINE NAME AND FILE NAME
!VERSION 1 JUST LOADS FROM STREAM 1 TO TEST THE BSP INTERFACE

SYSTEMROUTINESPEC  LINKIN(INTEGER  SER)
SYSTEMROUTINESPEC  MAP HWR(INTEGER  SEG)
SYSTEMROUTINESPEC  ALARM(INTEGER  TICKS)

RECORDFORMAT  DMF(INTEGER  I)

CONSTRECORD  (DMF) NAME  NIL = 0

RECORDFORMAT  XF(BYTEINTEGER  UNIT,FSYS, BYTEINTEGERARRAY  FNAME(0:5))
EXTERNALPREDICATESPEC  READ FNAME(RECORD (XF) NAME  FILE)
CONTROL  K'100001'

BEGIN 

     CONSTINTEGER  MAXNAMELEN = 63;     ! ALLOWABLE LENGTH OF MACHINE NAME

     RECORDFORMAT  MEF(RECORD  (MEF) NAME  LINK, BYTEINTEGER  LEN, C 
       TYPE, INTEGER  ADDRESS,PORT,RCOMM,TCOMM,      C 
          BYTEINTEGERARRAY  A(1:240) )


#if x
     RECORDFORMAT  PE(BYTEINTEGER  SER, REPLY, FN, S1, C 
       RECORD  (MEF) NAME  MES, BYTEINTEGER  GATE PORT, TASK PORT)
#else
     RECORDFORMAT  PE(BYTEINTEGER  SER, REPLY, FN, PORT, C 
      RECORD  (MEF) NAME  MES, BYTEINTEGER  S0,S1)
#fi

#if x

CONSTINTEGER  CONNECT=1
CONSTINTEGER  ACCEPT=2
CONSTINTEGER  DISCONNECT=3
CONSTINTEGER  ENABLE INPUT=4
CONSTINTEGER  PUT OUTPUT=5
CONSTINTEGER  EXPEDITED DATA=6
CONSTINTEGER  RESET=7
CONSTINTEGER  DATAGRAM=8
CONSTINTEGER  DATAGRAM REPLY=9
CONSTINTEGER  ENABLE FACILITY=10
CONSTINTEGER  DISABLE FACILITY=11
CONSTINTEGER  ENABLE OUTPUT=4
CONSTINTEGER  INPUT HERE=5

#else
!                       FUNCTION CODES TO BSPS
!                      -------------------------

CONSTINTEGER   ENABLEFACILITY=1
CONSTINTEGER   DISABLEFACILITY=2
CONSTINTEGER   CALLREPLY=3
CONSTINTEGER   ENABLEINPUT=4
CONSTINTEGER   PUTOUTPUT=5
CONSTINTEGER   CLOSECALL=6
CONSTINTEGER   ABORTCALL=7
CONSTINTEGER   OPENCALL=8
CONSTINTEGER   OPENMESSAGE=9

!                              FUNCTION CODES FROM BSPS
!                                 -----------------------

CONSTINTEGER   INCOMINGCALL=2
CONSTINTEGER   INPUTDONE=3
CONSTINTEGER   OUTPUTDONE=4
CONSTINTEGER   CALLCLOSED=5
CONSTINTEGER   CALLABORTED=6
CONSTINTEGER   OPENREPLY A=7
CONSTINTEGER   OPENREPLY B=8
CONSTINTEGER   MESSAGE R=9
CONSTINTEGER   MESSAGE REPLY=10

#fi
CONSTINTEGER  MAXLEN=120;       !MAX BUFFER SIZE IN WORDS

OWNINTEGER  STATE, PORT, TICKS, OLDNRECS, NRECS, I
OWNINTEGER  NBUFREQS;                         !OUTSTANDING BUFFER REQUESTS
OWNINTEGER  STARTED ABORT=0

OWNRECORD  (PE) P

!VALUES FOR STATE
CONSTINTEGER  IDLE=0
CONSTINTEGER  GOING=1
CONSTINTEGER  ABORTING=2
CONSTINTEGER  CLOSING=3

CONSTINTEGER  EOT=4

CONSTINTEGER  REQUEST BUFFER=0
CONSTINTEGER  RELEASE BUFFER=1

OWNRECORD  (XF) CONTROL FILE

CONSTINTEGER  NLFMAX=20
RECORDFORMAT  LFF(STRING (63) NAME, RECORD  (XF) FILE)
OWNRECORD  (LFF) ARRAY  LF(1:NLFMAX)
OWNINTEGER  NLF=0

!DATA FOR MANIPULATING FILE DESCRIPTORS
!***********************************************************
RECORDFORMAT  STRDF(INTEGER  A,B,C,D,RECORD  (XF) FILE,INTEGER  E,F,G,H)

RECORD  (STRDF) NAME  STRD

RECORDFORMAT  D1F(INTEGER  X)
RECORD  (D1F) D1
RECORDFORMAT  STRDXF(RECORD  (STRDF) NAME  STRD)
RECORDFORMAT  D2F(RECORD  (STRDXF) NAME  X)
RECORD  (D2F)NAME  D2
!************************************************************

!COMMAND TO NAME SERVER
CONSTINTEGER  REVLOOKUP=3

CONSTBYTEINTEGERNAME  INT=K'160060'
CONSTBYTEINTEGERNAME  OWN ID=K'160030'
CONSTINTEGER  BSP SER=16
CONSTINTEGER  NAME SERVER=15
CONSTINTEGER  BUFFER MANAGER=17

CONSTBYTEINTEGERNAME  CHANGE OUT ZERO=K'161340'
CONSTINTEGER  T3 SER=21

ROUTINESPEC  READ LOAD NAME(STRINGNAME  NAME)

ROUTINE  SEND(INTEGER  PORT, FN)
!---------------------------------

   P_SER=BSP SER;  P_REPLY=OWN ID
#if x
   P_FN=FN;      P_GATE PORT=PORT; P_TASK PORT=1
#else
   P_FN=FN;        P_PORT=PORT
#fi
   PON(P)
END 
#if x

ROUTINE  SEND DISCONNECT(INTEGER  PORT, FLAG)
!--------------------------------------------
   P_MES==NIL;  P_S1=FLAG
   SEND(PORT, DISCONNECT)
END 
#fi

#if x
ROUTINE  FACILITY(INTEGER  FN)
!----------------------------
RECORDFORMAT  P2F(BYTEINTEGER  SER, REPLY, FN, S1, STRING  (3) FAC)
RECORD  (P2F) P2
   P2_SER=BSP SER;  P2_REPLY=OWN ID
   P2_FN=FN;        P2_S1=0
   P2_FAC="ZBT"
   PON(P2)
END 

#fi
ROUTINE  FREEBUFFER(RECORD  (MEF) NAME  BUF)
!--------------------------------------------
RECORD  (PE) P
   P_SER=BUFFER MANAGER;    P_REPLY=OWN ID
   P_FN=RELEASE BUFFER;     P_MES==BUF
   PON(P)
END 

ROUTINE  GET BUFFER
!------------------
RECORD  (PE) P

   IF  NBUFREQS=0 START 
      NBUFREQS=NBUFREQS+1
      P_SER=BUFFER MANAGER;   P_REPLY=OWN ID
#if x
      P_FN=REQUEST BUFFER;    P_GATE PORT=0;  !long buffer
#else
      P_FN=REQUEST BUFFER;    P_S0=0;        !BIG BUFFER
#fi
      PON(P)
   FINISH 
END 

ROUTINE  ACCEPT CALL
!--------------------

#if x
   P_MES==NIL
   SEND(PORT, ACCEPT)
#else
   P_S1=1
   SEND(PORT, CALL REPLY)
#fi
END 

ROUTINE  REJECT CALL(INTEGER  PORT)
!-----------------------------------
#if x
   SEND DISCONNECT(PORT, 17);    !number busy
#else
   P_S1=0
   SEND(PORT, CALL REPLY)
#fi
END 

ROUTINE  SETSTREAM(RECORD  (XF) NAME  FILE)
!-------------------------------------------

   D1_X=K'160034';    !STREAM 1
   D2==D1;            !ALIAS D2 TO D1
   STRD==D2_X_STRD
   STRD_A=0;   STRD_B=2;   STRD_C=0;  STRD_D=OWN ID<<8!3
   STRD_FILE=FILE;   STRD_E=0;  STRD_F=0;  STRD_G=0;  STRD_H=K'172'

END 

ROUTINE  STARTTRANSFER(RECORD  (XF) NAME  FILE)
!-----------------------------------------------

   GETBUFFER
   STATE=GOING
   OLDNRECS=-1;   !USED TO DETECT STUCK LOADS
   TICKS=0;       !DITTO
   NRECS=0
   SETSTREAM(FILE)
   SELECTINPUT(1)
END 

ROUTINE  ERROR(INTEGER  I, RECORD  (MEF) NAME  BUF)
!---------------------------------------------------

   PRINTSTRING("ZBT: **** Data error ");   WRITE(I, 3)
   PRINTSTRING(" after ");   WRITE(NRECS, 3)
   PRINTSTRING(" records");   NEWLINE
   FREEBUFFER(BUF);
   CLOSEINPUT
#if x
   SEND DISCONNECT(PORT, 42)
#else
   SEND(PORT, ABORT CALL)
#fi
   STATE=ABORTING
END 

ROUTINE  READ DATA(RECORD  (MEF) NAME  BUF)
!-------------------------------------------
INTEGER  LEN, I, C

   SELECTINPUT(1)
   READSYMBOL(LEN)
   IF  LEN<=0 START ;       !END OF FILE
      CLOSEINPUT
#if x
      BUF_LEN=0
      P_MES==BUF
      P_S1=1;       !push flag to indicate end of data
      SEND(PORT, PUT OUTPUT)
#else
      SEND(PORT, CLOSE CALL)
      FREEBUFFER(BUF)
#fi
      STATE=CLOSING
      RETURN 
   FINISH 
   IF  LEN >MAXLEN START 
      ERROR(1, BUF)
      RETURN 
   FINISH 
   LEN=LEN+LEN+2
   CYCLE  I=1,1,LEN
      READSYMBOL(C)
      IF  C<0 START ;      !PREMATURE END OF FILE
         ERROR(2, BUF)
         RETURN 
      FINISH 
      BUF_A(I)=C
   REPEAT 
   BUF_LEN=LEN
   P_MES==BUF
#if x
   P_S1=0;      !not pushed
#fi
   SEND(PORT, PUT OUTPUT)
   NRECS=NRECS+1
END 

ROUTINE  GOT BUFFER
!-------------------

   NBUFREQS=NBUFREQS-1
   IF  STATE=GOING START 
      READ DATA(P_MES)
      RETURN 
   FINISH 
   FREE BUFFER(P_MES);       !DON'T WANT IT NOW
END 

INTEGERFN  EXIST(RECORD  (XF) NAME  FILE)
RECORDFORMAT  PF(BYTEINTEGER  SER, REPLY,                    C 
   INTEGER  A1, RECORD  (XF) NAME  A2, INTEGER  A3)
RECORD  (PF) P;                !TO INTERROGATE FILE SYS
      P_SER=4;                 !INTERROGATE FILE SYS
      P_REPLY=OWN ID
      P_A1=0;    P_A2==FILE;   P_A3=0
      PONOFF(P)
      IF  P_A1=0 START 
         PRINTSTRING(" **** No file!")
      FINISH 
      RESULT =P_A1
END 



INTEGERFNSPEC  ALTMATCH(STRING  (63) NAME  PATTERN, INTEGERNAME  PP, C 
      INTEGER  PLEN, STRING  (63) NAME  NAME, INTEGERNAME  NP, INTEGER  NLEN)

INTEGERFN  MATCH(STRING  (63) NAME  PATTERN, INTEGER  PP,PLEN, C 
       STRING  (63) NAME  NAME, INTEGER  NP, NLEN)
!------------------------------------------------------------------------------
! TRY TO MATCH PATTERN FROM PP ONWARDS WITH NAME FROM NP ONWARDS
INTEGER  POSN

PRINTSTRING("Try match :".pattern."["); write(pp,-1); printsymbol(',')
write(plen,-1); printstring("]   to  ".name."["); write(np,-1)
printsymbol(','); write(nlen,-1); printsymbol(']'); newline
NEWLINE
   CYCLE 
      IF  PLEN<PP START 
         IF  NLEN<NP THEN  RESULT =1;  !BOTH NULL
         RESULT =0;      !PATTERN NULL, NAME NOT NULL
      FINISH 
      IF  CHARNO(PATTERN,PP)='*' START 
         POSN=NLEN+1
         WHILE  POSN>=NP CYCLE ;      !match as much of name as possible
            IF  MATCH(PATTERN,PP+1,PLEN,NAME,POSN,NLEN)#0 THEN  RESULT =1
            POSN=POSN-1
         REPEAT 
         RESULT =0
       FINISH 
      IF  CHARNO(PATTERN, PP)='[' START 
         PP=PP+1
         RESULT =ALTMATCH(PATTERN, PP, PLEN, NAME, NP, NLEN)
      FINISH 
      IF  NLEN<NP THEN  RESULT =0;  !NAME NULL, PATTERN NOT NULL
      IF  CHARNO(PATTERN,PP)#CHARNO(NAME,NP) THEN  RESULT =0
      PP=PP+1
      NP=NP+1
   REPEAT 
END 


ROUTINE  SKIPKET(STRING (63) NAME  PATTERN, INTEGERNAME  PP, INTEGER  PL)
!------------------------------------------------------------------------
!Skip till we find a ] (matching [] on the way)
INTEGER  C
   WHILE  PP<=PL CYCLE 
      C=CHARNO(PATTERN,PP)
      PP=PP+1
      IF  C=']' THEN  RETURN 
      IF  C='[' THEN  SKIPKET(PATTERN, PP, PL)
   REPEAT 
   PRINTSTRING("Missing ] in "); PRINTSTRING(PATTERN); NEWLINE
END 

INTEGERFN  ALTMATCH(STRING  (63) NAME  PATTERN, INTEGERNAME  PP, C 
      INTEGER  PLEN, STRING  (63) NAME  NAME, INTEGERNAME  NP, INTEGER  NLEN)
!---------------------------------------------------------------------------
!perform alternatives match after [ has been found, PP and NP are updated
INTEGER  ENDPP, C, SAVENP

   CYCLE ;        !round alternatives
!find end of next alternative
      ENDPP=PP
      WHILE  ENDPP<=PLEN CYCLE 
         C=CHARNO(PATTERN,ENDPP)
         IF  C='[' START ;        !skip embedded alternatives
            ENDPP=ENDPP+1
            SKIP KET(PATTERN, ENDPP, PLEN)
            CONTINUE 
         FINISH 
         IF  C='|' OR  C=']' THEN  EXIT 
         ENDPP=ENDPP+1
      REPEAT 
      IF  ENDPP>PLEN START 
         PRINTSTRING("Missing ] in "); PRINTSTRING(PATTERN); NEWLINE
         RESULT =0
      FINISH 
      SAVENP=NP
      IF  MATCH(PATTERN, PP, ENDPP-1, NAME, NP, NLEN) # 0 START 
!this alternative has matched - skip to closing ]
         SKIP KET(PATTERN, ENDPP, PLEN)
         PP=ENDPP
         RESULT =1
      FINISH 
      NP=SAVENP;      !rescan name
      PP=ENDPP+1;     !next alternative
   REPEATUNTIL  C=']'
   RESULT =0;         !tried them all - no match
END 

ROUTINE  SAVE STREAM1
!---------------------

  D1_X=K'160034';  !STREAM 1 POINTER
  D2==D1
   STRD==D2_X_STRD
   CONTROL FILE=STRD_FILE
END 

ROUTINE  SKIPSPACES
!------------------

   WHILE  NEXTSYMBOL=' ' CYCLE ; SKIPSYMBOL; REPEAT 
END 

ROUTINE  READ CONTROL
!--------------------
STRING  (63) NAME
RECORD  (XF) FILE

   SETSTREAM(CONTROL FILE)
   SELECTINPUT(1);   !READ FROM CONTROL FILE
   NLF=0
   CYCLE 
      SKIPSPACES
      READ LOAD NAME(NAME)
      IF  LENGTH(NAME)=0 OR  NAME="END" THEN  EXIT 
      SKIPSPACES
      IF  NEXTSYMBOL=NL OR  NOT  READ FNAME(FILE) START 
         PRINTSTRING("ZBT: control file format error ")
         PRINTSTRING(NAME)
         NEWLINE
         CONTINUE 
      FINISH 
      IF  NLF=NLFMAX START 
         PRINTSTRING("ZBT: table full")
         NEWLINE
         EXIT 
      FINISH 
      NLF=NLF+1
      LF(NLF)_NAME=NAME
      LF(NLF)_FILE=FILE
   REPEAT 
   PRINTSTRING("ZBT: no. of names =")
   WRITE(NLF,3)
   NEWLINE
   CLOSEINPUT
END 

ROUTINE  READ LOAD NAME(STRINGNAME  NAME)
!------------------------------------------
INTEGER  C,L

   C=' '
   L=0
   UNTIL  L#0 OR  C=EOT CYCLE 
      READSYMBOL(C)
      WHILE  C#NL AND  C# ' ' AND  C#EOT CYCLE 
         IF  L<20 THEN  L=L+1 AND  CHARNO(NAME,L)=C
         READSYMBOL(C)
      REPEAT 
   REPEAT 
   LENGTH(NAME)=L
END 

ROUTINE  LOOKUP(INTEGER  ADDRESS, STRINGNAME  NAME)
!---------------------------------------------------
INTEGER  C,L
RECORDFORMAT  NSREQUESTF(INTEGERARRAY  DUMMY(0:6), BYTEINTEGER  Z,ADDR)
RECORD  (NSREQUESTF) NAME  NSREQUEST
RECORDFORMAT  NSREPLYF(INTEGERARRAY  DUMMY(0:5), INTEGER  RETURN CODE,C 
      STRING (63) NAME)
RECORD  (NSREPLYF) NAME  NSREPLY

   NAME = "?ANON?";     !DEFAULT NAME
!GET BUFFER FOR REQUEST TO NAME SERVER
   P_SER=BUFFER MANAGER; P_REPLY=OWN ID
#if x
   P_FN=REQUEST BUFFER;   P_GATE PORT=0;    !big buffer
#else
   P_FN=REQUEST BUFFER;  P_S0=0;     !BIG BUFFER
#fi
   PONOFF(P)
   NSREQUEST==P_MES
   NSREQUEST_ADDR=ADDRESS;        !FIND NAME OF THIS THING
   P_SER=NAME SERVER
   P_REPLY=OWN ID
   P_FN=REVLOOKUP
   PONOFF(P)
   IF  P_FN#0 START 
     PRINTSTRING("ZBT: No Name server!")
      NEWLINE;   RETURN 
   FINISH 
   NSREPLY==P_MES
   IF  NSREPLY_RETURN CODE#0 START 
      PRINTSTRING("ZBT: Nameserver error "); WRITE(NSREPLY_RETURN CODE, 3)
      PRINTSTRING(" for station ");   WRITE(ADDRESS, 3);   NEWLINE
   ELSE 
      IF  LENGTH(NSREPLY_NAME)> MAXNAMELEN THEN  C 
          LENGTH(NSREPLY_NAME) = MAXNAMELEN
      NAME=NSREPLY_NAME
   FINISH 
   FREEBUFFER(P_MES)
END 

ROUTINE  GET TSBSP NAME(RECORD (PE)NAME  P, STRINGNAME  NAME)
!--------------------------------------------------------------
#if x
!get 2nd ts paramater
RECORDFORMAT  PBUF(BYTEINTEGERARRAY  A(0:255))
RECORD  (PBUF) NAME  PB
INTEGER  I,L,J

   PB==P_MES
   I=4;       !Start of params area
   I=I+PB_A(I)+1;     !skip first param
   L=PB_A(I);         !length of 2nd param
   IF  L>MAXNAMELEN THEN  L=MAXNAMELEN
   LENGTH(NAME)=L
   IF  L=0 THEN  RETURN 
   CYCLE  J=1,1,L
      CHARNO(NAME, J) = PB_A(I+J);     !copy the name
   REPEAT 
#else
INTEGER  I,J,C
RECORDFORMAT  OPENF(STRING (19) DUMMY, C 
   BYTEINTEGERARRAY  TS(0:63) )
RECORD (OPENF)NAME  OP

   OP == P_MES
   I = P_MES_LEN
   IF  I > 6 START ;            !SOME TS INFORMATION
      ! BYTE SWOP THE MESSAGE
      I = ((I-5)<<1)
      J=0
      WHILE  J < I CYCLE 
         C = OP_TS(J+1) ; OP_TS(J+1) = OP_TS(J) ; OP_TS(J) = C
         J=J+2
      REPEAT 
      IF  OP_TS(0) = 16 AND  OP_TS(1) = 128 AND  OP_TS(2) > 128 START 
         I = OP_TS(2)&127
         I = MAXNAMELEN IF  I > MAXNAMELEN
         CYCLE  J = 1,1,I
            CHARNO(NAME,J) = OP_TS(J+2)
         REPEAT 
         LENGTH(NAME) = I
         RETURN 
      FINISH 
   FINISH 
   NAME = "";        !NO NAME AVAILABLE
#fi
END ;           !OF GET TSBSP NAME

ROUTINE  PRINTFILENAME(RECORD  (XF) NAME  FILE)
!-----------------------------------------------
INTEGER  I,C
   WRITE(FILE_UNIT,1); PRINTSYMBOL('.')
   CYCLE  I=0,1,5
      C = FILE_FNAME(I)
      PRINTSYMBOL(C) IF  C # ' '
   REPEAT 
   I=FILE_FSYS
   PRINTSYMBOL('(')
   PRINTSYMBOL((I>>3)+'0');PRINTSYMBOL((I&7)+'0')
   PRINTSYMBOL(')')
END 

ROUTINE  CLOCK CALL
!------------------
INTEGER  I

   IF  STATE=GOING AND  NRECS=OLDNRECS START ;  !SEE IF STUCK
      TICKS=TICKS+1
      IF  TICKS>4 START 
         PRINTSTRING("ZBT: Load stuck - aborting"); NEWLINE
#if x
         SEND DISCONNECT(PORT, 42)
#else
         SEND(PORT, ABORT CALL)
#fi
         STATE=ABORTING
      FINISH 
   ELSE 
      TICKS=0
   FINISH 
   OLDNRECS=NRECS

   IF  INT='A' START 
      IF  STARTED ABORT=1 AND  STATE=IDLE AND  NBUFREQS=0 THEN  STOP 

      IF  STARTED ABORT=0 START 
#if x
         FACILITY(DISABLE FACILITY)
#else
         P_S1=24
         SEND(PORT, DISABLE FACILITY)
#fi
         STARTED ABORT=1
      FINISH 
   FINISH 
   
   IF  INT='R' AND  STATE=IDLE START 
      INT=0
      READ CONTROL
   FINISH 
   IF  INT='?' START 
       PRINTSTRING("ZBT: state =");   WRITE(STATE,3)
      PRINTSTRING(" records sent ="); WRITE(NRECS,3)
      NEWLINE
      CYCLE  I=1,1,NLF
         PRINTSTRING(LF(I)_NAME);
         SPACES(22-LENGTH(LF(I)_NAME))
         PRINTFILENAME(LF(I)_FILE)
         NEWLINE
      REPEAT 
      INT=0
   FINISH 
   ALARM(100)
END 

#if ~x
ROUTINE  HANDLE ABORT
!----------------------

   IF  STATE#ABORTING START ;    !FROM NETWORK, NOT AN ACK
      PRINTSTRING("ZBT: Network Abort");  NEWLINE
      SELECTINPUT(1)
      CLOSEINPUT
      SEND(PORT, ABORT CALL)
   FINISH 
   STATE=IDLE
END 

#else
ROUTINE  ABORT STREAM
!--------------------
   IF  STATE#ABORTING START 
      SEND DISCONNECT(PORT, 42)
      STATE=ABORTING
   FINISH 
END 

#fi
ROUTINE  FROM BSPS
!------------------
INTEGER  I
INTEGER  INDEX
STRING (63) NAME, REVNAME

#if x
   IF  P_FN=CONNECT START 
      GET TSBSP NAME(P, NAME)
      FREE BUFFER(P_MES)
#else
   IF  P_FN=INCOMING CALL START 
#fi
      IF  STATE#IDLE START 
#if x
         REJECT CALL(P_GATE PORT)
#else
         REJECT CALL(P_PORT)
#fi
         PRINTSTRING("ZBT: Reject load request from ")
#if x
         PRINTSTRING(NAME);  NEWLINE
#else
         WRITE(P_S0, 3); NEWLINE
#fi
         RETURN 
      FINISH 
#if x
      PORT=P_GATE PORT
#else
      PORT=P_PORT
      GET TSBSP NAME(P,NAME);         ! SEE IF NAME PROVIDED BY CALLER
#fi
#if ~x
      LOOKUP(P_S0,REVNAME);           ! GET NAME BY REVERSE LOOKUP
      NAME = REVNAME IF  NAME = ""
#else
      REVNAME = NAME
#fi
      PRINTSTRING("ZBT: Load")
      INDEX=0;     !POSN OF FIRST NAME MATCHED
      CYCLE  I=1,1,NLF
         IF  MATCH(LF(I)_NAME, 1, LENGTH(LF(I)_NAME), NAME, 1, LENGTH(NAME) )#0 THEN  INDEX=I ANDEXIT 
      REPEAT 
      IF  INDEX=0 START 
         PRINTSTRING(" file not specified for ")
         PRINTSTRING(NAME)
      ELSE 
         PRINTFILENAME(LF(INDEX)_FILE)
         PRINTSTRING(" to ");  PRINTSTRING(NAME)
      FINISH 
      IF  NAME # REVNAME START 
         PRINTSTRING(" via ")
         PRINTSTRING(REVNAME)
      FINISH 
      IF  INDEX=0 OR  EXIST(LF(INDEX)_FILE)=0 START 
         NEWLINE
         REJECT CALL(PORT)
         RETURN 
      FINISH 
      NEWLINE
      ACCEPT CALL
      START TRANSFER(LF(INDEX)_FILE)
      RETURN 
   FINISH 
#if x
   IF  P_FN=ENABLE OUTPUT START 
#else
   IF  P_FN=OUTPUT DONE START ;       !LAST BLOCK GONE
#fi
      IF  STATE=GOING START 
         GET BUFFER
      FINISH 
      RETURN 
   FINISH 
#if x
   IF  P_FN=DISCONNECT START 
      UNLESS  P_MES==NIL THEN  FREE BUFFER(P_MES)
#else
   IF  P_FN=CALL CLOSED START 
#fi
      IF  STATE=CLOSING START ;         !LOAD FINISHED
         PRINTSTRING("ZBT: Load finished");  NEWLINE
         STATE=IDLE
#if x
         SEND DISCONNECT(PORT, 1)
#fi
         RETURN 
      FINISH 
#if x
      IF  STATE=ABORTING START 
         STATE=IDLE
         SELECTINPUT(1)
         CLOSEINPUT
         RETURN 
      FINISH 
      PRINTSTRING("ZBT: Abort from the ring"); NEWLINE
      SEND DISCONNECT(PORT, 1)
#else
      PRINTSTRING("ZBT: Incoming Close");   NEWLINE
      SEND(PORT, CLOSE CALL)
#fi
      SELECTINPUT(1)
      CLOSEINPUT
      STATE=IDLE
      RETURN 
   FINISH 
#if x
!handle the entries which shouldn't happen
   IF  P_FN=RESET START 
      UNLESS  P_MES==NIL THEN  FREEBUFFER(P_MES)
      PRINTSTRING("ZBT: network reset, I give up")
      NEWLINE
      ABORT STREAM
      RETURN 
   FINISH 
   IF  P_FN=EXPEDITED DATA START 
      PRINTSTRING("ZBT: expedited data");   NEWLINE
      ABORT STREAM
      RETURN 
   FINISH 
   IF  P_FN=DATAGRAM START 
      GET TSBSP NAME(P, NAME)
      PRINTSTRING("ZBT: datagram received from ");
      PRINTSTRING(NAME);  NEWLINE
      FREEBUFFER(P_MES)
      RETURN 
   FINISH 
   PRINTSTRING("ZBT: Illegal FN from TSBSP"); WRITE(P_FN,1); NEWLINE
#else
   IF  P_FN=CALL ABORTED START 
      HANDLE ABORT
      RETURN 
  FINISH 
  IF  P_FN=INPUT DONE THEN  FREEBUFFER(P_MES);  !SHOULDN'T HAPPEN
#fi
END 

!START MAIN PROGRAM

   MAP VIRT(BUFFER MANAGER, 5, 4)
   MAP VIRT(BUFFER MANAGER, 6, 5)
   CHANGE OUT ZERO=T3 SER
   PRINTSTRING("ZBT: version 6 ")
   PRINTSTRING(DATESTRING)
#if x
   PRINTSTRING(" (ts)")
#fi
   NEWLINE
!DEFINE DEFAULT FILE BY LOOKING AT STREAM 1
   SAVE STREAM1;   !SAVE ID OF CONTROL FILE
   READ CONTROL;   !INPUT TABLE OF NAMES/LOAD FILES
!ENABLE FACILITY
#if x
   FACILITY(ENABLE FACILITY)
#else
   P_S1=24;
   SEND(PORT, ENABLE FACILITY)
#fi
   ALARM(100)
   CYCLE 
      P_SER=0;   POFF(P)
      IF  P_REPLY=0 START 
         CLOCKCALL
      ELSE 
         IF  P_REPLY=BUFFER MANAGER THEN  GOTBUFFER ELSEC 
            FROM BSPS
      FINISH 
   REPEAT 

ENDOFPROGRAM