!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