ASMB,Q,C
      HED <RPRTL>: MINI-APLDL MASTER ROUTINE (C) HEWLETT PACKARD CO. *1980* 
      NAM RPRTL,19,90 91750-16224 REV 2013 800709 RTE-L 'RP' MASTER 
      SUP 
      SPC 2 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
*  ***************************************************************
* 
*    NAME:   RPRTL
*    SOURCE: 91750-18224
*    RELOC:  91750-16224
*    PGMR:   L. WEIMAN [6/6/80] 
* 
      EXT OPEN,CLOSE,READF,EXEC,REIO,NAMR 
      EXT PRTN,DSERR,.MVW,CNUMD 
      EXT #RQB,#MAST,#NODE
* 
*     THIS PROGRAM IS USED TO DOWN-LOAD AN ABSOLUTE PROGRAM FILE
*     (CREATED BY RTE-L LOADER) INTO AN OPERATING RTE-L SYSTEM, 
*     WHICH ALREADY HAS HAD DS/1000 INITIALIZED.  IT REQUIRES THE 
*     RTE-L PROGRAM DOWN-LOAD MONITOR APLDX ('LITTLE APLDR FOR RTE-L')
*     TO BE INITIALIZED.
* 
*     TO RUN PROGRAM: 
* 
*  :RU,RPRTL,[<ERROR PRINTOUT LU>],<REMOTE NODE NUMBER>,<PROGRAM FILE NAMR> 
* 
*     WHERE <PROGRAM FILE NAMR = FMP <NAMR> FOR FILE, INCLUDING NAME, 
*                                OPTIONAL SECURITY CODE & CARTRIDGE 
*                                REFERENCE NUMBER.  (FILE MUST BE 
*                                LOCATED IN SAME NODE AS THIS PROGRAM). 
* 
*           <REMOTE NODE> = NODE NUMBER TO TRANSFER PROGRAM TO
* 
*           [ERROR PRINTOUT LU]= LU TO USE TO PRINT ERRORS. 
*                         IF ZERO OR NEGATIVE, ERRORS NOT PRINTED.
* 
*     'DS' ERRORS ARE RETRIED 15 TIMES.  IF THE ERROR PERSISTS, IT
*     IS REPORTED ON THE ERROR LU, IF ONE WAS GIVEN.
* 
*     IF ANY ERROR OCCURS, AND THE ERROR LU PARAMETER HAS BEEN
*     SUPPLIED, THE APPROPRIATE ERROR MESSAGE IS PRINTED (SEE MINI-APLDR
*     LISTING FOR DETAILS).  THE ERROR CODES DEFINED THERE ARE RETURNED 
*     TO THE 'FATHER' PROGRAM, IF THERE IS ONE. 
* 
*     ADDITIONAL ERROR CODES, DEFINED ON MASTER SIDE: 
* 
*     P1 = 0   NO ERROR 
* 
*     P1 = -1  IMPROPER 'RUN' STRING, PARAMETERS NOT SUPPLIED.
* 
*     P1 = -2  FILE 'OPEN' ERROR.  P2 CONTAINS FMP 'OPEN' ERROR CODE
* 
*     P1 = -3 FILE SPECIFIED NOT REAL RTE-L PROGRAM LOAD FILE 
* 
*     P1 = -4 DS ERROR OCCURRED, RESULTS IN P2-P5.  P2 & P3 CONTAIN 
*             ASCII ERROR (E.G., 'DS01'), P4 CONTAINS REPORTING NODE
*             NUMBER, P5 CONTAINS ERROR QUALIFIER.
*     P1 = -5 FMP 'READ' ERROR OCCURRED, ERROR RETURNED IN P2 
* 
*     FOR DOCUMENTATION ON REQUEST & REPLY FORMATS, SEE APLDX LISTING 
      SKP 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
* 
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
      SKP 
* APBLK-START 
* 
******************************************************************
*                                                                *
*       A P L D X         G L O B A L  B L O C K  REV 2013 800611*
*                                                                *
*     GLOBAL OFFSETS FOR APLDX MESSAGE BUFFERS, USED BY          *
*                                                                *
*      RPRTL     APLDX                                           *
******************************************************************
* 
* 
* DEFINE APLDX REQUEST BUFFER 
* 
#FCOD EQU #MHD      FUNCTION CODE 
#ERCD EQU #FCOD     ERROR-RETURN CODE 
#P1   EQU #ERCD+1 
#P2   EQU #ERCD+2 
#P3   EQU #ERCD+3 
#P4   EQU #ERCD+4 
#P5   EQU #ERCD+5 
#P6   EQU #ERCD+6 
#P7   EQU #ERCD+7 
#P8   EQU #ERCD+8 
#P9   EQU #ERCD+9 
#P10   EQU #ERCD+10 
#P11   EQU #ERCD+11 
#P12   EQU #ERCD+12 
#ADR  EQU #P1 
* 
***************************************************** 
* 
* 
* APBLK-END 
* 
      SKP 
      SPC 2 
RPRTL EQU * 
      CLA           SET INDICATOR THAT WE HAVEN'T 
      STA ABRAD       ESTABLISHED AN ID SEGMENT YET 
      CCA              AND ASSUME THERE WILL BE AN ERROR
      STA AB1 
* 
      JSB EXEC      GET STRING
      DEF *+5 
      DEF D14 
      DEF D1
BUFA  DEF BUFFR 
      DEF DM80      80-CHARACTER STRING 
* 
      SZA           WAS THERE ANY STRING? 
      JMP NOSTR     NO
      STB LEN       SAVE STRING LENGTH
      CLA,INA       INITIALIZE STRING POINTER 
      STA NPNTR 
      JSB XNAMR     CALL NAMR 
      JSB XNAMR         THREE 
      JSB XNAMR              TIMES
* 
      LDA PARSB     GET ERROR LU
      STA ERRLU     SAVE
* 
      JSB XNAMR     GO GET NODE NUMBER
      LDA PARSB+3   WAS THIS
      AND B7          PARAMETER 
      SZA,RSS          DEFAULTED? 
      JMP NONOD     YES, NO NODE WAS GIVEN. 
      LDA PARSB     SAVE NODE NUMBER
      STA NODE
* 
      JSB XNAMR 
* 
      DLD PARSB     MOVE FILE NAME
      DST FNAME 
      LDA PARSB+2 
      STA FNAME+2 
      DLD PARSB+4 
      DST SCODE 
* 
*     ATTEMPT TO OPEN THE FILE WE WERE GIVEN
* 
      JSB OPEN
      DEF *+7 
      DEF DCB 
      DEF IERR
      DEF PARSB     FILE NAME 
      DEF D5        NON-EXCLUSIVE 'OPEN' & FORCE TYPE TYPE 1
      DEF PARSB+4   SECURITY CODE 
      DEF PARSB+5   CARTRIDGE REFERENCE NUMBER
* 
      SSA           ERROR?
      JMP FOERR     FILE OPEN ERROR 
* 
*     READ ID SEGMENT 
* 
      JSB XREAD     READ FILE RECORD
* 
*     CHECK CHECKSUM WORD 
* 
      LDA DM30
      STA CNTR
      LDA BUFFR 
      LDB BUFA
      INB 
      ADA B,I       ADD IN NEXT WORD
      ISZ CNTR
      JMP *-3       STAY IN LOOP TILL ALL SUMMED
* 
      CPA BUFFR+31  IS THIS REALLY AN RTE-L ID SEGMENT? 
      RSS           YES, IT IS
      JMP NOTID     NO, IT'S NOT.  PRINT ERROR
* 
*     OVERLAY PROGRAM NAME WITH FILE NAME 
*     AND MOVE PROGRAM NAME TO MESSAGE BUFFER 
* 
      DLD PARSB     MOVE CHARACTERS 1 
      DST BUFFR+12    THROUGH 4 
      DST .PG 
      LDA PARSB+2   PICK UP CHARACTER 5 
      AND =B77400   MASK UPPER BYTE 
      STA B         SAVE
      LDA BUFFR+14    MERGE 
      AND =B377         WITH LOW
      IOR B                  BYTE OF ID SEGMENT 
      STA BUFFR+14
      AND =B77400 
      IOR RCART     INCLUCE ">" 
      STA .PG+2 
* 
*     MOVE DATA TO ID SEGMENT AREA
      LDA BUFA
      LDB IDSGA 
      JSB .MVW      MOVE TO ID SEGMENT AREA 
      DEF IDSIZ 
      NOP 
* 
* 
*     SEND ID SEGMENT TO SLAVE, FOR BOUNDS & OTHER CHECKING 
* 
      LDA =D31      IDENTIFY US AS 'RTE-L' FATHER TO SLAVE
      ALF,ALF           (ID CODE PASSED IN HIGH BYTE) 
      LDB IDSIZ     SET DATA LENGTH=ID SEGMENT SIZE 
      JSB SNDMS     SEND MESSAGE
      DEF IDSEG         <BUFFER ADDRESS>
      ABS #P1+1      REQUEST LENGTH 
* 
      LDA #RQB+#ADR SAVE THE ID SEGMENT'S ADDRESS 
      STA ABRAD 
* 
*     ** SEND PROGRAM AREA
* 
      LDA ID+21     COMPUTE SIZE OF PROGRAM AREA
      STA ADDR         (& INITIALIZE MEMORY ADDRESS)
      LDB ID+22 
      STB HADDR        (& INITIALIZE HIGH MEMORY ADDRESS) 
      JSB CNBLK 
      SZA,RSS       ANY PROGRAM DATA TO SEND? 
      JMP BP        NO, GO ON 
* 
PRLUP EQU *         LOOP TO READ PROGRAM DATA 
      JSB XREAD 
      LDA D1        FUNCTION CODE FOR PROGRAM DATA = 1
      JSB SNDMS 
      DEF BUFFR     <BUFFER ADDRESS>
      ABS #P1+2      REQUEST LENGTH 
* 
      LDA ADDR      ADVANCE 
      ADA D128        MEMORY
      STA ADDR         ADDR PNTR
      ISZ CNTR      END OF LOOP?
      JMP PRLUP     NO, CONTINUE XFR
* 
*     *** SEND BASE PAGE AREA 
* 
BP    EQU * 
      LDA ID+25     COMPUTE NUMBER OF 
      AND B1777       BLOCKS IN 
      STA B             BASE PAGE AREA
      STA HADDR       (& INITIALIZE HIGH MEMORY ADDRESS)
      LDA ID+24 
      AND B1777 
      STA ADDR      INITIALIZE TRANSFER ADDRESS 
      JSB CNBLK 
      SZA,RSS       ANY BASE PAGE TO SEND?
      JMP FIN       NO, SKIP THIS PART
* 
PBLUP EQU *         STORE BASE PAGE AREA LOOP 
      JSB XREAD 
* 
      LDA D2         FUNCTION CODE = 2
      JSB SNDMS     SEND MESSAGE
      DEF BUFFR     <BUFFER ADDRESS>
      ABS #P1+1     <BUFFER LENGTH> 
* 
* 
      LDA ADDR      ADVANCE 
      ADA D128        MEMORY
      STA ADDR         POINTER
      ISZ CNTR
      JMP PBLUP     CONTINUE IN LOOP UNTIL ALL BP XFRD
* 
*     WE'RE FINISHED.  TELL SLAVE TO FINISH UP. 
* 
FIN   EQU * 
      LDA @FNAM     MOVE FILE NAME, SECURITY CODE,
      LDB @RQB1       CRN, ETC., TO REQUEST 
      JSB .MVW            BUFFER
      DEF D5
      NOP 
* 
      LDA #NODE 
      STA #RQB+#P6  PASS MASTER NODE #
* 
      LDA IDSEG+23  GET # OF SHORT
      ALF,ALF         ID
      RAR,RAR            SEGMENTS 
      AND =B77
      CMA,INA              AND PASS TO SLAVE AS 
      STA #RQB+#P7           A NEGATIVE COUNTER 
* 
      LDA IDSEG+20   PASS LOW MAIN
      STA #RQB+#P8    TO SLAVE
* 
      LDA IDSEG+21  PASS HIGH MAIN+1
      STA #RQB+#P9    TO SLAVE
* 
      LDA IDSEG+23  PASS LOW BASE PAGE ADDRESS
      AND  B1777      TO SLAVE
      STA #RQB+#P10 
* 
      LDA IDSEG+24  PASS HIGH BASE PAGE+1 
      AND =B1777      TO SLAVE
      STA #RQB+#P11 
* 
      LDA ABRAD     PASS ID SEGMENT ADDRESS 
      STA #RQB+#P12   TO SLAVE
* 
      LDA D3        TERMINATE FUNCTION CODE=3 
      CLB 
      JSB SNDMS 
      DEF ZERO      <NO BUFFER> 
      ABS #P12+1     REQUEST LENGTH 
* 
*     PROGRAM DOWN-LOAD IS COMPLETE.
* 
      JSB XREIO 
      DEF OKMES     DOWN-LOAD OK
      DEF OKMSL 
* 
      CLA           RETURN NO-ERROR CODE
      STA AB1       (CLEAR FLAG WHICH WAS SET AT BEGINNING SAYING ERROR)
* 
EXIT0 EQU * 
      CMA,INA 
      STA BUFFR        TO FATHER PROGRAM
* 
EXIT1 EQU * 
*                   IF AN ERROR HAS OCCURRED, AND WE'VE ESTABLISHED AN
*                   ID SEGMENT, WE'LL HAVE TO CLEAR IT OUT. 
      ISZ AB1       ERROR?
      JMP EXIT2     NO, DON'T CLEAR ID
      LDA ABRAD     HAVE WE SET UP AN 
      SZA,RSS         ID SEGMENT YET? 
      JMP EXIT2         NO, NOTHING TO CLEAR
* 
*     CLEAR ID SEGMENT WE SET UP.  SEND 'ABORT' MESSAGE TO SLAVE. 
* 
      STA #RQB+#ADR TELL IT WHICH ID TO CLEAR 
* 
      CLA           CLEAR ID SEGMENT
      STA IDSEG+12
      STA IDSEG+13
      STA IDSEG+14
* 
      LDA D4        ABORT: FUNCTION CODE=4
      LDB IDSIZ       DATA LENGTH = ID SEGMENT SIZE 
      JSB SNDMS     SEND MESSAGE
      DEF IDSEG     <BUFFER ADDRESS>
      ABS #P1+1       REQUEST LENGTH
* 
EXIT2 EQU * 
      JSB CLOSE     CLOSE THE FILE
      DEF *+3 
      DEF DCB 
      DEF IERR
* 
      JSB PRTN      PASS RESULTS TO 'FATHER', IF THERE IS ONE 
      DEF *+2 
      DEF BUFFR 
* 
      JSB EXEC
      DEF *+2 
      DEF D6
      SKP 
* 
*     SUBROUTINE TO READ FILE RECORDS FOR US
XREAD NOP 
      JSB READF 
      DEF *+6 
      DEF DCB 
      DEF IERR
      DEF BUFFR 
      DEF D128
      DEF LEN 
      SSA,RSS       ERROR?
      JMP XREAD,I   NO ERROR--RETURN TO POINT OF CALL 
* 
*     A FILE 'READ' ERROR HAS OCCURRED. 
* 
      STA BUFFR+1   RETURN TO CALLER
      CMA,INA       MAKE IT POSITIVE
      STA IERR
      JSB CNUMD 
      DEF *+3 
      DEF IERR
      DEF .ER1. 
* 
      JSB XREIO 
      DEF FRERR 
      DEF FRERL 
      LDA D5        RETURN ERROR CODE -5
      JMP EXIT0     NOTE: COMPLEMENTED AT LABEL EXIT0 
      SPC 2 
      SPC 2 
NOSTR EQU *         NO 'RUN' STRING, OR IMPROPER PARAMETERS 
      LDB ERRLU     WAS AN ERROR LU SUPPLIED? 
      SZB,RSS 
      JMP NOST1 
* 
      JSB XREIO 
      DEF NOSTM 
      DEF NOSTL 
* 
NOST1 EQU * 
      LDA D1        RETURN ERROR CODE -1
      JMP EXIT0     NOTE: COMPLEMENTED AT LOCN EXIT0
NOTID EQU *         FILE SPEC'D NOT RTE-L PROGRAM LOAD FILE 
      JSB XREIO 
      DEF NOFIL 
      DEF NOFLL 
* 
      LDA D3        RETURN ERROR CODE -3
      JMP EXIT0     NOTE: COMPLEMENTED AT EXIT0 
      SPC 2 
NONOD EQU *         NO REMOTE NODE WAS GIVEN
      JSB XREIO 
      DEF NOX 
      DEF NOXL
* 
      CLA,INA       RETURN ERROR CODE -1
      JMP EXIT0     NOTE:COMPLEMENTED AT LABEL EXIT0
      SPC 2 
FOERR EQU *         FILE OPEN ERROR 
      LDB IERR
      STB BUFFR+2 
* 
      LDB ERRLU     IS THERE AN ERROR LU? 
      SZB,RSS 
      JMP FOER1     NO, JUST RETURN THE ERROR CODE
      CMA,INA       MAKE ERROR CODE POSITIVE
      STA IERR
      JSB CNUMD 
      DEF *+3 
      DEF IERR
      DEF .ER2. 
      JSB XREIO 
      DEF FOERX 
      DEF FOERL 
* 
FOER1 EQU * 
      LDA D2        RETURN ERROR CODE -2
      JMP EXIT0       (NOTE: THIS IS COMPLEMENTED AT LOCN EXIT0)
      SKP 
*     SUBROUTINE TO CODE & SEND A MESSAGE TO REMOTE RTL-L 
*     DOWN-LOAD MONITOR 
* 
*     CALLING SEQUENCE: 
*     SET ADDR = ADDRESS WHERE YOU WANT THE BLOCK TO GO 
*     SET HADDR = HIGH ADDRESS OF THE AREA YOU WANT LOADED
*     SET <A> = FUNCTION CODE YOU WANT
*         <B> = DATA LENGTH (NOT NECESSARY ON FN CODES 1 & 2) 
* 
*     JSB SNDMS 
*     DEF <BUFFER>
*     DEC <REQUEST LENGTH>
*     <NORMAL RETURN>   RETURN HERE IF NO ERRORS
      SPC 2 
SNDMS NOP 
      STA FCODE     SAVE FUNCTION CODE
      STB LEN        SAVE DATA BUFFER LNTH
      LDA SNDMS,I   GET BUFFER ADDRESS
      STA .BUFR        SAVE IT
      ISZ SNDMS     BUMP PNTR TO LNTH 
* 
      LDA SNDMS,I   GET REQUEST LENGTH
      STA RQLEN        SAVE REQUEST LENGTH
      ISZ SNDMS     BUMP PNTR TO <NORMAL> RETURN
* 
      LDA MNTRY     INITIALIZE RETRY
      STA RTRYC        COUNTER
* 
RETRY EQU *         HERE ON RETRIES 
      LDA FCODE     PICK UP FUNCTION CODE 
* 
      STA #RQB+#FCOD SAVE FUNCTION CODE 
* 
      CPA D1        FUNCTION CODE = 1?
      JMP C.        YES, CALCULATE DATA LENGTH
      CPA D2          2?
      RSS 
      JMP SNDM.     NO, DON'T CALCULATE LENGTH, USE 0 
* 
C.    EQU * 
* 
      LDA ADDR      SET ADDRESS 
      STA #RQB+#ADR 
* 
*     CALCULATE DATA LENGTH.  IF WE HAVE MORE THAN 128 WORDS TO 
*     GO, THEN SUBSTITUTE 128.
* 
      LDB D128
      LDA ADDR      CALCULATE DATA
      CMA,INA       LENGTH
      ADA HADDR 
      STA LEN       SAVE LENGTH 
      CMA,INA         IS THIS 
      ADA D128          LENGTH
      SSA                 > 128?
      STB LEN             YES, USE 128
SNDM. EQU * 
* 
      LDA NODE
      STA #RQB+#DST 
      LDA STREM 
      STA #RQB+#STR 
* 
* 
* 
      JSB #MAST 
      DEF *+7 
      DEF CONWD 
      DEF RQLEN     REQUEST LNTH
.BUFR NOP           <DATA BUFFER ADDRESS STORED HERE> 
      DEF LEN       LENGTH OF DATA (IF ANY) 
      DEF ZERO      INCOMING DATA BUFFER LENGTH 
      DEF M#MXR     MAX REPLY LENGTH
        JMP DSER    'DS' ERROR
* 
      LDA #RQB+#FCOD DID SLAVE PROGRAM
      SZA,RSS         REJECT? 
      JMP SNDMS,I   NO, RETURN TO CALLER
* 
*     SLAVE PROGRAM DIDN'T LIKE WHAT WE GAVE IT.
* 
      STA BUFFR     WE WANT TO RETURN RESULTS TO OUR 'FATHER' 
      CPA D4        PROGRAM CONFLICT? 
      RSS 
      JMP .1        NO, CONTINUE
* 
*     MOVE NAME OF PROGRAM WHICH NEEDS TO BE REMOVED TO MSG BUFR
* 
      LDA @RQB1 
      LDB @PRGM 
      JSB .MVW
      DEF D3
      NOP 
      LDA @RQB1       AND MOVE PROGRAM TO RETURN BUFFER PARAMETERS
      LDB BUFA
      INB 
      JSB .MVW
      DEF D3
      NOP 
* 
      LDA .PRGM+2   INSERT A BLANK IN 
      AND =B77400     6TH CHARACTER POSITION
      IOR =B40
      STA .PRGM+2 
* 
      LDB BLANK     PLACE 'MR' IN MESSAGE IF PROGRAM
      LDA #RQB+#P4    IS MEMORY-RESIDENT
      SSA           'MR' BIT SET? 
      LDB "MR       YES 
      STB .PMR
      STB BUFFR+4 
* 
      LDA #RQB+#FCOD RECOVER FUNCTION CODE AGAIN
* 
.1    EQU * 
      ADA DM1       CONVERT TO ZERO-BASED SUBSCRIPT 
      RAL 
      ADA @ERTB     CONVERT ERROR CODE TO ERROR TABLE PNTR
      DLD A,I       LOAD MSG ADDRESS & LNTH 
      DST RJ. 
* 
      JSB XREIO      PRINT ERROR MSG
RJ.   BSS 2         ERROR MESSAGE ADDRESS & LNTH GO HERE
      JMP EXIT1 
      SPC 2 
*     HERE ON ANY ERRORS FROM #MAST 
* 
DSER  EQU * 
      DLD #RQB+#EC1 PICK UP ERROR CODE INFO 
      CPA =ADS      WAS THIS A 'DS' ERROR?
      RSS           YES, POSSIBLY RETRYABLE 
      JMP DSER.     NO, NO RETRIES
      CPB =A04      DS04 ERROR? 
      JMP DSER.       YES, RETRIES WON'T HELP 
      CPB =A07      DS07 ERROR? 
      JMP DSER.     YES, RETRIES WON'T HELP 
      ISZ RTRYC     BUMP RETRY COUNTER. TRY AGAIN?
      RSS            YES, BUT TELL OPERATOR WE HAD TROUBLE....
      JMP DSER.      NO, JUST PRINT ERROR MESSAGE & QUIT
* 
      DST RTMSG     SAVE 4-CHAR ERROR 
      JSB XREIO     PRINT THE TROUBLE WE HAD
      DEF RTMSG 
      DEF RTMSL 
* 
      JMP RETRY       AND RETRY 
* 
DSER. EQU * 
*     RETURN ERROR CODE, QUALIFIER AND REPORTING NODE NUMBER
*     IN PARAMETERS RETURNED TO 'FATHER'
      DST BUFFR+1    MOVE TO 'FATHER' 
      LDA #RQB+#ENO 
      LDA #RQB+#ECQ 
      AND =B170 
      RAR,RAR 
      RAR 
      STA BUFFR+4 
* 
*     CALL 'DSERR' TO OBTAIN THE PROPER ERROR MESSAGE & PRINT IT
* 
      JSB DSERR 
      DEF *+2 
      DEF BUFFR+5 
* 
      JSB XREIO 
      DEF BUFFR+5 
      DEF D24 
* 
      LDA D4        RETURN ERROR CODE -4
      JMP EXIT0 
      SKP 
*     SUBROUTINE TO CALL 'REIO' FOR US, WITHOUT NEEDING TO SUPPLY 
*     ALL THOSE EXTRA DEFS
* 
*     CALLING SEQUENCE: 
*     JSB XREIO 
*     DEF <BUFFER>
*     DEF <BUFFER LNTH> 
*     <RETURN>
* 
XREIO NOP 
      DLD XREIO,I   PICK UP BOTH DEFS 
      DST XR..
* 
      LDA ERRLU     IS THERE
      SZA,RSS         AN ERROR LU SPECIFIED?
      JMP X.R       NO, JUST EXIT 
      JSB REIO      CALL REIO 
      DEF *+5 
      DEF D2N       NO-ABORT 'WRITE' CODE 
      DEF ERRLU 
XR..  BSS 2         TWO <DEFS> STORED HERE
      NOP           --ERROR RETURN (IGNORED)
* 
X.R   EQU * 
      ISZ XREIO     BUMP RETURN POINTER PAST
      ISZ XREIO      THE TWO DEFS 
      JMP XREIO,I      ..AND RETURN TO CALLER 
      SPC 2 
*     SUBROUTINE TO CALL 'NAMR' FOR US, WITHOUT NEEDING 
*     ALL THOSE REPETITIVE DEFS 
* 
XNAMR NOP 
      JSB NAMR
      DEF *+5 
      DEF PARSB     PARSE BUFFER
      DEF BUFFR     STRING BUFFER 
      DEF LEN       BUFFER LENGTH 
      DEF NPNTR     STRING POINTER
      JMP XNAMR,I 
      SKP 
* 
*     SUBROUTINE TO COMPUTE # BLOCKS IN AN AREA 
* 
*     CALLING SEQUENCE: 
* 
*     LDA (LOW ADDRESS) 
*     LDB (HIGH ADDRESS+1)
*     JSB CNBLK     CALCULATE # OF BLOCKS 
*     <RETURN>  <A>= CNTR = NEGATIVE NUMBER OF BLOCKS, OR 0 
*                   (I.E., <A> = ((HIGH ADDR+1)-LOW ADDR+127))/128
* 
CNBLK NOP 
      CMA,INA 
      ADA B 
      ADA =B177 
      ALF,ALF 
      RAL 
      AND =B777 
      CMA,INA 
      STA CNTR
      JMP CNBLK,I 
      SKP 
*     DATA AREA 
B7    OCT 7 
B1777 OCT 1777
ZERO  DEC 0 
D1    DEC 1 
D2    DEC 2 
D2N   OCT 100002    NO-ABORT 'WRITE' CODE 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D14   DEC 14
D24   DEC 24
D34   DEC 34
D128  DEC 128 
DM1   DEC -1
DM30  DEC -30 
DM80  DEC -80 
* 
@PRGM DEF .PRGM 
@RQB1 DEF #RQB+#P1
* 
FCODE NOP           STORAGE FOR 'SNDMS' FUNCTION CODE 
MNTRY DEC -15       NUMBER OF RETRIES ON EACH 'DS' ERROR
RTRYC NOP           RETRY COUNTER 
NPNTR NOP           STRING POINTER
ERRLU NOP 
CONWD OCT 100000    NO-ABORT
STREM DEC 11        STREAM TYPE 
RQLEN NOP           REQUEST LENGTH
LEN   NOP 
CNTR  NOP 
ADDR  NOP 
HADDR NOP 
* 
IDSIZ EQU D34       ID SEGMENT SIZE 
@FNAM DEF FNAME 
      SPC 2 
*     DO NOT RE-ARRANGE ORDER OF NEXT ITEMS!
FNAME BSS 3         FILE NAME 
SCODE NOP           FILE SECURITY CODE
      NOP           FILE CARTRIDGE REFERENCE NUMBER 
*     END OF ORDER-SENSITIVE AREA 
      SPC 2 
NODE  NOP           REMOTE NODE NUMBER
DCB   BSS 144       FILE DATA CONTROL BLOCK 
IERR  NOP 
BUFFR BSS 128 
PARSB BSS 10        PARSE BUFFER
* 
AB1   NOP           FLAG INDICATING ABORTING ERROR CAUSED TERMINATION 
ABRAD NOP           STORAGE FOR ID SEGMENT'S ADDRESS
IDSGA DEF IDSEG 
IDSEG BSS 34
ID    EQU IDSEG-1   DEFINE ZERO-OFFSET ID-SEG SYMBOL
* 
M#MXR ABS #MXR      MAX HEADER LENGTH 
      SPC 2 
*     ERROR CODE-TO-MESSAGE CONVERSION TABLE
*     ENTRIES ARE MADE TWO TO AN ERROR CODE.  FIRST 
*     ENTRY IS ADDRESS OF MESSAGE.  2ND ENTRY IS DEF TO ITS LENGTH. 
@ERTB DEF *+1       ERROR CODE TABLE
* 
      DEF UFC       1: UNRECOGNIZED FUNCTION CODE 
      DEF UFCL
* 
      DEF DPRN      2:DUPLICATE PROGRAM NAMES 
      DEF DPRNL 
* 
      DEF NOIDS     3:NO BLANK ID SEGMENTS
      DEF NOIDL 
* 
      DEF PRCFT     4:PROGRAM CONFLICT
      DEF PRCFL 
* 
      DEF CKSM.     5:SYSTEM CHECKSUM MISMATCH
      DEF CKSML 
* 
      DEF ILBFA     6:ILLEGAL BG LOAD ATTEMPT 
      DEF ILBFL 
* 
*     END OF TABLE *************************************
      SKP 
*     ASCII MESSAGES
NOSTM ASC 13,IMPROPER 'RUN' STRING, OR NONE GIVEN 
NOSTL ABS *-NOSTR 
UFC   ASC 7,UNREC FN CODE 
UFCL  ABS *-UFC 
* 
DPRN  ASC 11,DUPLICATE PROGRAM NAME 
DPRNL ABS *-DPRN
* 
NOIDS ASC 10,NO BLANK ID SEGMENTS 
NOIDL ABS *-NOIDS 
* 
PRCFT ASC 4,REMOVE
.PRGM ASC 3,
.PMR  ASC 1,
PRCFL ABS *-PRCFT 
* 
CKSM. ASC 17,PRGM NOT RELOCATED W/CORRECT SNAP
CKSML ABS *-CKSM. 
* 
ILBFA ASC 9,ILLEGAL BG LOAD ATTEMPT 
* 
RTMSG ASC 2,        STORAGE FOR 4-CHAR DS ERROR MESSAGE 
      ASC 8, ERROR. RETRYING
RTMSL ABS *-RTMSG 
ILBFL ABS *-ILBFA 
* 
*     "FILE OPEN ERROR-DDDDDD"
FOERX ASC 8,FILE OPEN ERROR-
.ER2. ASC 3,
FOERL ABS *-FOERX 
* 
NOX   ASC 13,MUST SPECIFY REMOTE NODE!
NOXL  ABS *-NOX 
* 
NOFIL ASC 15,THAT'S NOT AN RTE-L LOAD-FILE! 
NOFLL ABS *-NOFIL 
* 
*     "FILE READ ERROR-DDDDDD"
FRERR ASC 8,FILE READ ERROR-
.ER1. ASC 3,
FRERL ABS *-FRERR 
* 
*     "PROGRAM <AAAAA> DOWN-LOAD COMPLETE"
OKMES ASC 5,PROGRAM < 
.PG   ASC 3,        STORAGE FOR PROGRAM NAME
      ASC 10, DOWN-LOAD COMPLETE
OKMSL ABS *-OKMES 
* 
RCART OCT 76        ASCII ">" IN LOW BYTE 
BLANK ASC 1,        TWO ASCII BLANKS
"MR   ASC 1,MR      'MR'
      SPC 2 
A     EQU 0 
B     EQU 1 
      UNS 
      END RPRTL