!z80 TCP BOOT PROGRAM
!VERSION 1 JUST LOADS FROM STREAM 1 TO TEST THE BSP INTERFACE
!2:6:81
!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
!8:6:81
!!  STK = 300,  STRM = 1


%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

     %CONSTSTRING (7)VSN = 'VSN005B'


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



     %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, FN, PORT, %C
      %RECORD (MEF) %NAME MES, %BYTEINTEGER S0,S1)




!                       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




%CONSTINTEGER MAXLEN=120;       !MAX BUFFER SIZE IN WORDS

%OWNINTEGER STATE, PORT, NRECS, I
%OWNINTEGER NMARK;               !USED IN MONITORING MESSAGES
%OWNINTEGER NBUFREQS;                         !OUTSTANDING BUFFER REQUESTS


%OWNRECORD (PE) P



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


!DATA FOR EOT SKIPPING GETCHAR ROUTINE

%CONSTINTEGER EOT=4
%OWNINTEGER NEOT, HOLDC



%CONSTINTEGER REQUEST BUFFER=0
%CONSTINTEGER RELEASE BUFFER=1



%CONSTINTEGER NLFMAX=4
%RECORDFORMAT LFF(%INTEGER ADDRESS, %RECORD (XF) FILE)
%OWNRECORD (LFF) %ARRAY LF(1:NLFMAX)
%OWNINTEGER NLF=0
%OWNBYTEINTEGERARRAY DEFAULTFILE(0:5)='Z','T','C','P',' ',' '

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

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


%INTEGER RUBBISH

%INTEGERFN GETCHAR

   %IF NEOT>0 %THEN NEOT=NEOT-1 %ANDRESULT=EOT
   %IF NEOT=0 %THEN NEOT=-1 %ANDRESULT=HOLDC

   READSYMBOL(HOLDC)
   %IF HOLDC=EOT %START
      %WHILE HOLDC=EOT %CYCLE
         READSYMBOL(HOLDC)
         NEOT=NEOT+1
      %REPEAT
      %IF HOLDC>=0 %THENRESULT=EOT %ELSE NEOT=-1 %ANDRESULT=-1
   %FINISH
   %RESULT=HOLDC
%END

%ROUTINE SEND(%INTEGER FN)

   P_SER=BSP SER;  P_REPLY=OWN ID
   P_FN=FN;        P_PORT=PORT
   PON(P)
%END

%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
     P_FN=REQUEST BUFFER;    P_S0=0;        !BIG BUFFER
      PON(P)
   %FINISH
%END

%ROUTINE ACCEPT CALL

   P_S1=1
   SEND(CALL REPLY)
%END

%ROUTINE REJECT CALL
%INTEGER SAVE PORT

   SAVE PORT=PORT;   PORT=P_PORT
   P_S1=0
   SEND(CALL REPLY)
   PORT=SAVE PORT
%END


%ROUTINE SETSTREAM(%RECORD (XF) %NAME FILE)
%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 D2F(%RECORD (STRDF) %NAME STRD)
%RECORD (D2F) %NAME D2


   D1_X=K'160034';    !STREAM 1
   D2==D1;            !ALIAS D2 TO D1
   STRD==D2_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_K=K'172'

%END

%ROUTINE STARTTRANSFER(%RECORD (XF) %NAME FILE)

   GETBUFFER
   STATE=GOING
   NRECS=0
   NMARK=1
   CLOSEINPUT
   SETSTREAM(FILE)
   SELECTINPUT(1)
   NEOT=-1;            !NO WAITING EOTS
%END

%ROUTINE ERROR(%INTEGER I, %RECORD (MEF) %NAME BUF)

   PRINTSTRING("***ZBOOT DATA ERROR ");   WRITE(I, 3)
   PRINTSTRING(" AFTER ");   WRITE(NRECS, 3)
   PRINTSTRING(" RECORDS");   NEWLINE
   FREEBUFFER(BUF);
   SEND(ABORT CALL)
   STATE=ABORTING
%END

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

   LEN=GETCHAR
   %IF LEN<0 %START;       !END OF FILE
      SEND(CLOSE CALL)
      STATE=CLOSING
      FREEBUFFER(BUF)
      %RETURN
   %FINISH
   %IF LEN>MAXLEN %START
      ERROR(1, BUF)
      %RETURN
   %FINISH
   LEN=LEN+LEN+2
   %CYCLE I=1,1,LEN
      C=GETCHAR
      %IF C<0 %START;      !PREMATURE END OF FILE
         ERROR(2, BUF)
         %RETURN
      %FINISH
      BUF_A(I)=C
   %REPEAT
   BUF_LEN=LEN
   P_MES==BUF
   SEND(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


%ROUTINE READ AND STORE(%INTEGER ADDRESS)
%INTEGER I
%RECORDFORMAT PF(%BYTEINTEGER SER, REPLY,                    %C
   %INTEGER A1, %RECORD (XF) %NAME A2, %INTEGER A3)
%RECORD (PF) P;                !TO INTERROGATE FILE SYS
%RECORD (XF) FILE

   %IF READ FNNAME(FILE) %START
      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");  NEWLINE
         %RETURN

      %FINISH
   %ELSE
      %RETURN
   %FINISH
!SAVE FILE NAME & ADDRESS IN LOAD FILE ARRAY
   %CYCLE I=1,1,NLF
      %IF LF(I)_ADDRESS=ADDRESS %START
         LF(I)_FILE=FILE
         %RETURN
      %FINISH
      %IF I=NLF %START;         !ADD ADDRESS TO LF LIST
         %IF NLF=NLFMAX %START
            PRINTSTRING("TABLE FULL");  NEWLINE
         %ELSE
            NLF=NLF+1
            L(I)_ADDRESS=ADDRESS
            L(I)_FILE=FILE
         %FINISH
         %RETURN
      %FINISH
   %REPEAT

%END
%ROUTINE READ AND LOOKUP(%INTEGERNAME ADDRESS)
%INTEGER C,L
%RECORDFORMAT NSREQUESTF(%INTEGERARRAY DUMMY(0:6), %STRING(61) NAME)
%RECORD (NSREQUESTF) %NAME NSREQUEST
%RECORDFORMAT NSREPLYF(%INTEGERARRAY DUMMY(0:6), %INTEGER RETURN CODE,%C
      %BYTEINTEGER FLAGS,ADDRESS)
%RECORD (NSREPLYF) %NAME NSREPLY
%STRINGNAME NAME

   ADDRESS=0

!GET BUFFER FOR REQUEST TO NAME SERVER
   P_SER=BUFFER MANAGER; P_REPLY=OWN ID
   P_FN=REQUEST BUFFER;  P_S0=0;     !BIG BUFFER
   PONOFF(P)
   NSREQUEST==P_MES
   NAME==NSREQUEST_NAME
   READSYMBOL(C);   L=0
   %WHILE C#NL %CYCLE
      %IF L<60 %THEN L=L+1 %AND CHARNO(NAME,L)=C
   %REPEAT
   LENGTH(NAME)=L
   P_SER=NAME SERVER
   P_REPLY=OWN ID
   P_FN=LOOKUP
   PONOFF(P)
   %IF P_FN#0 %START
     PRINTSTRING("NO NAME SERVER")
      NEWLINE;   %RETURN
   %FINISH
   NSREPLY==P_MES
   %IF NSREPLY_RETURN CODE#0 %START
      PRINTSTRING("ERROR RETURN "); WRITE(NSREPLY_RETURN CODE, 3)
      PRINTSTRNG(" FROM NAME SERVER");   NEWLINE
   %ELSE
      ADDRESS=NSREPLY_ADDRESS
   %FINISH
   FREEBUFFER(P_MES)

%END

%ROUTINE SET LOAD FILE;                      !CALLED ON INT 'S'
%INTEGER ADDRESS

   SELECTINPUT(0)
   PROMPT("DESTINATION DEVICE NAME=")
   READ AND LOOKUP(ADDRESS)
   %IF ADDRESS=0 %THEN %RETURN;              !SOME SORT OF ERROR
   PROMPT("LOAD FILE:")
   READ AND STORE(ADDRESS)

%END

%ROUTINE CLOCK CALL
   
   %IF INT='S' %START
      INT=0
      SET LOAD FILE
   %FINISH
   %IF INT='?' %START
       PRINTSTRING("ZBOOT: STATE=");   WRITE(STATE,3)
      PRINTSTRING(" RECORDS SENT="); WRITE(NRECS,3)
      NEWLINE
      INT=0
   %FINISH
   ALARM(100)
%END


%ROUTINE HANDLE ABORT

   %IF STATE#ABORTING %START;    !FROM NETWORK, NOT AN ACK
      PRINTSTRING("ZBOOT:NETWORK ABORT");  NEWLINE
      SEND(ABORT CALL)
   %FINISH
   STATE=IDLE
%END

%ROUTINE FROM BSPS
%INTEGER I


   %IF P_FN=INCOMING CALL %START
      %IF STATE#IDLE %START
         REJECT CALL
         PRINTSTRING("ZBOOT:REJECT LOAD REQUEST FROM")
         WRITE(P_S0, 3); NEWLINE
         %RETURN
      %FINISH
      PORT=P_PORT
      ACCEPT CALL
      PRINTSTRING("ZBOOT:START LOAD TO "); WRITE(P_S0, 3)
      PRINTSTRING(" FROM ")
      %CYCLE I=0,1,5
          PRINTSYMBOL(FILE_FNAME(I))
      %REPEAT
      NEWLINE
!FIND THE LOAD FILE, LF(1) IS THE DEFAULT FILE
!SO SEARCH BACKWARDS FROM NLF TO 1
      %CYCLE I=NLF,-1,1
         %IF LF(I)_ADDRESS=P_S0 %OR I=1 %THEN %EXIT
      %REPEAT
      START TRANSFER(LF(I)_FILE)
      %RETURN
   %FINISH
   %IF P_FN=OUTPUT DONE %START;       !LAST BLOCK GONE
      %IF NRECS=NMARK %START
         PRINTSTRING("ZBOOT: "); WRITE(NRECS, 3)
         PRINTSTRING(" RECORDS GONE"); NEWLINE
         NMARK=NMARK<<1
      %FINISH
      %IF STATE=GOING %START
         GET BUFFER
      %FINISH
      %RETURN
   %FINISH
   %IF P_FN=CALL CLOSED %START
      %IF STATE=CLOSING %START;         !LOAD FINISHED
          PRINTSTRING("ZBOOT:LOAD FINISHED");  NEWLINE
         STATE=IDLE
         %RETURN
      %ELSE;                             !INCOMING CLOSE????
         PRINTSTRING("ZBOOT:INCOMING CLOSE");   NEWLINE
         SEND(CLOSE CALL)
         STATE=IDLE
         %RETURN
      %FINISH
   %FINISH
   %IF P_FN=CALL ABORTED %START
      HANDLE ABORT
      %RETURN
  %FINISH
  %IF P_FN=INPUT DONE %THEN FREEBUFFER(P_MES);  !SHOULDN'T HAPPEN

%END



!START MAIN PROGRAM

   SELECTINPUT(1)
   MAP VIRT(BUFFER MANAGER, 5, 4)
   MAP VIRT(BUFFER MANAGER, 6, 5)
   CHANGE OUT ZERO=T3 SER
!DEFINE DEFAULT FILE
   LF(1)_ADDRESS=0;  LF(1)_FILE_UNIT=0;
   LF(1)_FILE_FSYS=13;                   !OCTAL (15)
   %CYCLE I=0,1,5
      LF(1)_FILE_FNAME(I)=DEFAULT FILE(I)
   %REPEAT
   NLF=1
!ENABLE FACILITY
   P_S1=24;
   SEND(ENABLE FACILITY)
   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