ASMB,R,L,C
      HED PROGL 91740-16012 REV 1913 * (C) HEWLETT-PACKARD CO 1979
      NAM PROGL,19,30 91740-16012 REV 1913 790128 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 4 
****************************************************************
* 
*     PROGL 
* 
*     SOURCE PART # 91740-18012 
* 
*     REL PART #    91740-16012 
* 
*     WRITTEN BY    CHUCK WHELAN
* 
*     DATE WRITTEN  MAY 1976
* 
*     MODIFIED BY  DMT
* 
*     DATE MODIFIED 780117
*     MODIFIED BY LYLE WEIMAN, JAN '78
* 
*************************************************************** 
      SPC 3 
* 
* 
*    DS/1000 PROGL MODULE FOR CONCURRENT MULTI-TERMINAL DOWNLOADS 
* 
      ENT PROGL 
* 
      EXT EXEC,OPEN,READF,CLOSE,#REQU,$OPSY 
      EXT #PRLU,CNUMD,KCVT,LOCF,DRTEQ 
* 
* 
* 
#ACTV EQU 4         NUMBER OF ACTIVE DOWNLOADS AT ONE TIME
* 
#TERM EQU 32        NUMBER OF POSSIBLE COMM. LINES
* 
      SKP 
* 
* 
*       "PROGL" IS A DISTRIBUTED SYSTEM COMMUNICATIONS MONITOR.  IT 
*  SERVICES ALL SYSTEM DOWNLOAD REQUESTS FROM "CBL" SOFTWARE AT 
*  REMOTE SATELLITES.  WHEN A NEW REQUEST IS RECEIVED, THE REQUESTED
*  ABSOLUTE FILE CONTAINING THE CORELOAD IS TRANSMITTED RECORD-BY-
*  RECORD USING CLASS I/O WRITE/READ OPERATIONS TO THE COMMUNICATIONS 
*  DRIVER ("DVA65").
* 
*       WHEN "PROGL" IS NOT EXECUTING IT IS IN A CLASS I/O GET
*  SUSPENSION WAITING FOR AN ENTRY TO BE PLACED ON THE CLASS QUEUE
*  FOR ITS CLASS NUMBER.  ENTRIES ARE PLACED ON THIS QUEUE WHEN A 
*  NEW DOWNLOAD REQUEST IS RECEIVED OR A PREVIOUS CLASS I/O WRITE 
*  COMPLETES. 
* 
*       THE REQUEST PASSED TO "PROGL" BY "QUEUE" HAS THE EQT ADDR IN THE
*  1ST WORD, AND THE DOWNLOAD FILE NUMBER (BINARY) IN THE 2ND WORD. 
*  THE DOWNLOAD FILE NUMBER IS CONVERTED TO AN ASCII FILE NAME CONSISTING 
*  OF "P" FOLLOWED BY THE FIVE ASCII DIGIT OCTAL EQUIVALENT OF THE
*  NUMBER.
* 
*       THE NUMBER OF DOWNLOADS THAT CAN BE ACTIVE AT ANY ONE TIME
*  IS LIMITED ONLY BY SYSTEM AVAILABLE MEMORY AND THE SIZE OF THE 
*  ACTIVE DOWNLOAD TABLE.  IN-PROCESS DOWNLOADS HAVE AN ENTRY IN
*  THIS TABLE CONSISTING OF LU, SEQ #, THE 144 WORD DCB FOR THE DOWNLOAD
*  FILE, AND THE FILE NUMBER.  IF A NEW REQUEST IS RECEIVED WHILE 
*  THIS TABLE IS FULL, IT IS PLACED IN A TWO WORD (LU, & FILE #)
*  ENTRY IN A WAIT QUEUE.  WHEN AN ENTRY BECOMES AVAILABLE
*  IN THE ACTIVE TABLE, AN ENTRY IN THE WAIT QUEUE CAN BE ACTIVATED.
*  THE NUMBER OF ENTRIES IN THE ACTIVE TABLE IS SET AT ASSEMBLY TIME
*  BY THE ITEM "#ACTV". 
* 
*       THE LU AND SEQ # OF A DOWNLOAD REQUEST ARE PASSED IN THE
*  REQUEST BUFFER OF EACH CLASS I/O WRITE/READ.  THE PROGRAM ENSURES
*  THAT ONLY ONE DOWNLOAD TO A LU IS IN PROCESS BY RE-USING THE SAME
*  TABLE ENTRY WITH A NEW SEQ # IF A DOWNLOAD IS RESTARTED, AND 
*  IGNORING I/O COMPLETIONS (ERRORS OR NOT) WITH WRONG SEQ. NUMBERS.
* 
*       EACH TIME THAT "PROGL" IS ENTERED ON A CLASS WRITE
*  COMPLETION, IT CHECKS THE RETURNED ERROR STATUS FOR DRIVER 
*  ERRORS AND IF NONE, READS THE NEXT RECORD FROM THE DOWNLOAD
*  FILE, WRITES IT TO THE DRIVER AND AGAIN SUSPENDS ON ITS CLASS. 
* 
*       WHEN ALL RECORDS IN THE DOWNLOAD FILE HAVE BEEN SUCCESSFULLY
*  TRANSMITTED, "PROGL" SENDS A ONE-WORD REQUEST TO THE SATELLITE 
*  TO INDICATE THE DOWNLOAD IS COMPLETE.  AT THIS TIME, THE FILE IS 
*  CLOSED (UNLESS IT IS OPEN MORE THAN ONCE), THE TABLE ENTRY IS CLEARED, 
*  AND UNLESS A WAIT QUEUE ENTRY CAN BE ACTIVATED, "PROGL" AGAIN SUSPENDS 
*  ON ITS CLASS.
* 
* 
*     OPTIONAL FEATURE:  THE USER MAY ELECT TO HAVE 'PROGL' PRINT 
*     A MESSAGE ON A SPECIFIED LU EACH TIME A DOWN-LOAD IS INITIATED, 
*     AND ALSO AT TERMINATION ( SUCCESS OR FAILURE).  AN EXAMPLE
*     MESSAGE IS SHOWN BELOW: 
*INITIATING VIA LU     7 DOWNLOAD OF FILE:P00000 AT DAY      5,  9 :10AM
*DOWNLOAD OF FILE:P00000 AT DAY      5,  9 :11AM WAS SUCCESSFUL 
* 
*     THE TIME OF INITIATION AND TIME OF TERMINATION ARE PRINTED (NOT 
*     NECESSARILY EQUAL). 
* 
*     THERE ARE TWO WAYS TO SELECT THIS OPTION: 
*      1) PROGRAMMATICALLY--WRITE A PROGRAM TO DECLARE '#PRLU' AS AN
*         EXTERNAL SYMBOL (THIS SYMBOL IS IN SUBSYSTEM GLOBAL AREA, SO
*         THE PROGRAM MUST BE LOADED GIVING IT ACCESS TO SSGA). 
*         IT SHOULD STORE THE LU ON WHICH YOU WANT THESE MESSAGES IN
* 
*         #PRLU.
*      2) AT GENERATION TIME--IN THE SECTION WHERE ENTRY POINT REPLACEMENTS 
*         ARE ACCEPTED BY THE RTE GENERATOR, ENTER THE FOLLOWING
*         LINE (THIS IS AN EXAMPLE, SHOWING HOW TO SPECIFY THAT THE 
*         MESSAGES ARE TO BE PRINTED ON LU 1):
* 
*           #PRLX,ABS,1 
* 
      SKP 
* 
*  PROGL IS ENTERED HERE INITIALLY
PROGL BSS 0         ENTRY.
      LDA 1,I 
      SZA,RSS 
      JMP PGET      NOT FIRST TIME
      STA ICLAS     SAVE PROGL'S CLASS
      AND MSK14     RELEASE CLASS BUFFER
      STA CLAS2     SAVE CLASS # FOR PROGL
      CLA 
      LDB $OPSY     SYSTEM TYPE FLAG
      RBR,SLB       SKIP IF NON-DMS SYSTEM
      STA MOD1      SET TO DO "XLA" 
*  INITIALIZE FILE NUMBERS
      LDB NACTV     SET UP LOOP 
      STB CNTR       COUNTER = - # ENTRIES
      LDB D12N      LOAD CLOSED MARKER
      CCA           POINT TO FIRST
      ADA TABAD      FILE NUMBER ENTRY
BUMP  ADA TLENT 
      STB 0,I       STORE MARKER
      ISZ CNTR      DONE? 
      JMP BUMP       NO. MARK NEXT ONE
* 
* 
*  SUSPEND UNTIL A NEW REQUEST IS WRITTEN TO MONITOR OR COMPLETION
*  ON A PREVIOUS DRIVER WRITE OCCURS
* 
PGET  JSB EXEC      WAIT FOR NEXT REQST OR I/O COMPLETION 
      DEF *+7 
      DEF D21 
      DEF ICLAS 
      DEF BUFR
      DEF D2
      DEF BFADR     ADDRESS OF REQ.BUFR IN SAM
      DEF RQLEN     LENGTH OF REQUEST 
* 
      STA IERR      SAVE STATUS 
      LDA RQLEN 
      CPA D3        IF REQ LEN IS 3, THIS IS I/O COMPLETION 
      JMP IOCOM     PROCESS I/O COMPLETION
      CPA D4        ONE OF OUR OWN PRINTOUTS? 
      JMP IGNOR     YES, RELEASE THE BUFFER & AWAIT NEXT ONE. 
      JSB RLEAS     RELEASE CLASS BUFFER
* 
*  PROCESS NEW DOWNLOAD REQUEST 
* 
      CLB 
      LDA EQTA      FWA OF EQT AREA 
      CMA,INA 
      ADA BUFR      ADD THE EQT ADDR PASSED IN BUFFER 
      DIV D15       COMPUTE EQT # 
      INA 
      STA EQT#      SAVE EQT #
      LDB LUMAX 
      CBX           X HAS NO OF LU'S
      ADB DRT       POINT TO END OF DRT TABLE 
* 
NXTLU ADB M1        DECREMENT DRT POINTER 
      LDA 1,I       GET DRT ENTRY 
      AND B77       ISOLATE EQT # 
      CPA EQT#      MATCH?
      JMP FOUND     YES 
      DSX           COUNT 
      JMP NXTLU     DO NEXT 
      JMP PGET      LU NOT FOUND! IGNORE REQUEST
* 
FOUND CXA 
      STA LU        SET LU OF NEW REQUEST 
      JSB SRCH      SEARCH FOR ENTRY IN DOWNLOAD TABLE
      CLB,RSS       THIS LU WASN'T IN TABLE 
      JMP RSTRT     FOUND, CLEAR & RESTART
* 
*  NO PREVIOUS ACTIVE ENTRY FOR LU
      CPB CURAD     WAS DOWNLOAD TABLE FULL?
      JMP FULL      YES, QUEUE THIS ENTRY 
      LDA LU        LU
      STA CURAD,I   STORE IN 1ST WORD OF DOWNLOAD ENTRY 
      JMP RSTR1 
* 
*  SAME LU, USE SAME TABLE ENTRY WITH NEW SEQ # & TIME-TAGS 
RSTRT EQU * 
      JSB PRFAL     PRINT OLD FILE NAME & MSG THAT
      DEF .ABR1       DOWN-LOAD WAS ABORTED 
      JSB CLSE      CLOSE PREVIOUS DOWNLOAD FILE
      SPC 2 
RSTR1 EQU * 
      LDB BUFR+1    FILE # FROM PARMB 
* 
*  CONVERT FILE # TO BE DOWNLOADED INTO FILE NAME.
NEWLD EQU * 
*                   CONVERT FILE NUMBER TO ASCII FILE NAME, AND 
*                   ALSO CONVERT TIME-OF-DAY TO ASCII.
      LDA DCBAD     GET ADDRESS IN TABLE WHERE
      ADA D144        FILE # IS TO BE STORED
      STB 0,I       STORE FILE NUMBER THERE.
      JSB GFNAM 
* 
      ISZ POOLS     UPDATE POOL SEQUENCE NUMBER 
ZERO  NOP 
      LDA POOLS     GET SEQ # OF THIS DOWNLOAD FROM POOL
      STA SEQAD,I   2ND WORD OF DOWNLOAD ENTRY
      STA SEQ#      PASS IN REQUEST 
* 
*  OPEN FILE TO BE DOWNLOADED 
      JSB OPEN      DO FMGR OPEN
      DEF *+5 
      DEF DCBAD,I   DCB ADDRESS 
      DEF IERR
      DEF NAME
      DEF ZERO
* 
      LDA #PRLU     DOES USER WISH AN ANNOUNCEMENT OF THIS? 
      SZA,RSS 
      JMP POPN1     NO, CONTINUE
      STA LUPRN     YES, SAVE PRINT LU
* 
      JSB LOCF      FIND FILE LU
      DEF *+9 
      DEF DCBAD,I 
      DEF SRCH      DON'T CARE ABOUT THIS ERROR 
      DEF SRCH      DON'T CARE ABOUT 'IREC' PARAMETER 
      DEF SRCH      DON'T CARE ABOUT 'IRB' PARAMETER
      DEF SRCH      DON'T CARE ABOUT 'IOFF' PARAMETER 
      DEF SRCH      DON'T CARE ABOUT 'JSEC' PARAMETER 
      DEF .DLU      SAVE FILE LU HERE 
      DEF .TYP      SAVE FILE TYPE HERE 
      JSB KCVT      CONVERT FILE LU TO ASCII
      DEF *+2 
      DEF .DLU
      STA .DLU
      JSB KCVT      CONVERT FILE TYPE 
      DEF *+2 
      DEF .TYP
      STA .TYP
* 
      JSB CNUMD     CONVERT LINE LU NUMBER TO ASCII 
      DEF *+3 
      DEF LU
      DEF .LU.
      JSB EXEC      PRINT IT
      DEF *+8 
      DEF D18N      PROTECT OURSELVES AGAINST BOGUS LU
      DEF LUPRN 
      DEF MSG1
      DEF MSG1L 
      DEF D0
      DEF D4
      DEF ICLAS     USE OUR OWN CLASS NUMBER
      NOP 
* 
POPN1 EQU * 
* 
      LDA IERR
      SSA,RSS       FILE OPENED OK? 
      JMP NEXT      YES, SEND NEXT RECORD 
      SPC 2 
OPNER EQU * 
      LDB #PRLU     USER WANT MESSAGES? 
      SZB,RSS 
      JMP ERR1      NO, JUST CLEAR OUT ENTRY
      STB LUPRN 
      CMA,INA       MAKE ERROR NEGATIVE FOR "CNUMD" TO CONVERT
      STA IERR
      JSB CNUMD 
      DEF *+3 
      DEF IERR
      DEF FILER 
      JSB EXEC      PRINT FILE-OPEN ERROR MESSAGE 
      DEF *+8 
      DEF D18N
      DEF LUPRN 
      DEF MSG3
      DEF MSG3L 
      DEF D0
      DEF D4
      DEF ICLAS 
      NOP 
      JSB PRFAL     PRINT "DOWNLOAD FAILED" MESSAGE 
      DEF .FAIL 
      JMP ERR1
      HED SEND NEXT DOWNLOAD RECORD      * (C) HEWLETT-PACKARD CO 1979
* 
* 
*  ENTER HERE WHEN COMPLETION OF PREVIOUS WRITE HAS OCCURRED
* 
IOCOM LDB BFADR     POINT TO REQUEST BUFFER 
      INB           POINT TO 2ND WORD (IN S.A.M.) 
      JSB LODWD     GET THE ASSOCIATED LU 
      STA LU
      INB           POINT TO 3RD WORD 
      JSB LODWD     GET THE ASSOCIATED PROGL SEQ #
      STA SEQ#
      JSB SRCH      FIND DOWNLOAD TABLE ENTRY FOR LU
      JMP IGNOR     LU NOT IN TABLE, IGNORE 
      LDA SEQAD,I   GET SEQ # OF TABLE ENTRY
      CPA SEQ#      DOES IT MATCH?
      RSS           YES 
      JMP IGNOR     NO, IGNORE THIS COMPLETION
*  CHECK DRIVER ERROR STATUS
      LDA IERR      GET ERROR STATUS FROM DRIVER
      SLA           LSB OF EQT5 
      JMP ACCPT     NO ERRORS, DO NEXT
* 
*  DRIVER ERROR OCCURRED
* 
      AND B170      TEST FOR PRTY, TIME-OUT, REMOTE BUSY, STOP
      CLE,SZA,RSS   ANY OF THESE? 
      JMP FAIL      NO, TREAT AS HARD FAILURE 
* 
      LDA CURAD,I   GET RETRY COUNT 
      ADA RTBIT     BUMP RETRY COUNT
      STA CURAD,I 
      SEZ           RETRIES EXHAUSTED?
      JMP FAIL      YES 
* 
      ISZ ERCNT     KEEP RETRY COUNT
      NOP            FOR THOSE INTERESTED 
      JSB EXEC      SUSPEND FOR 200 MILLISECS 
      DEF *+6 
      DEF D12N
      DEF D0
      DEF D1
      DEF D0
      DEF M20 
D0    NOP 
      LDA LU
      AND B77 
      STA LU
      JSB DRTEQ    GET THE LOGICAL UNIT 
      DEF *+2        SUBCHANNEL BITS
      DEF LU          FROM THE DRT
      ALF,CLE,ELA  POSITION SUBCHANNEL LSB TO <E> 
      LDA ICNWD    REMOVE THE PREVIOUS SUBCHANNEL LSB 
      AND M5         FROM THE CONTROL WORD
      SEZ          IF THE OUTPUT LU SPECIFIES AN ODD SUBCHANNEL,
      IOR D4         THEN SET BIT # 2 
      STA ICNWD      IN THE CONFIGURED CONTROL WORD 
      JSB #REQU     RETHREAD FOR ANOTHER OUTPUT 
      DEF *+5 
      DEF ICLAS 
      DEF ICLAS 
      DEF LU
      DEF ICNWD 
      SZA,RSS       OK? 
      JMP PGET      YES 
* 
FAIL  JSB RLEAS     RELEASE CLASS BUFFER
      JSB PRFAL     PRINT "DOWNLOAD FAILED..." MESSAGE
      DEF .FAL1 
      JMP ERR3      CLEAR OUT TABLE ENTRY 
* 
IGNOR JSB RLEAS     RELEASE CLASS BUFFER
      JMP PGET      BACK TO GET 
* 
ACCPT JSB RLEAS     RELEASE CLASS BUFFER
      SKP 
* 
*  THIS SECTION IS ENTERED TO GET NEXT RECORD FROM DOWNLOAD FILE. 
* 
NEXT  JSB READF     READ NEXT RECORD
      DEF *+6 
DCBAD NOP 
      DEF IERR
      DEF DBUF
      DEF MAXL      MAX ALLOWED LENGTH
      DEF LENX      ACTUAL LENGTH 
* 
      LDA IERR      CHECK FOR ERRORS
      SSA 
      JMP ERR2      ERROR IN FILE READ
* 
      LDA LENX
      SSA           CHECK FOR END-OF-FILE 
      JMP EOFND     FOUND, WRAP IT UP 
* 
*  VERIFY CHECKSUM OF NEXT RECORD TO BE DOWNLOADED
* 
      LDA DBUF
      ALF,ALF 
      AND B377
      STA 1         SAVE BUFFER LENGTH IN B 
      SZA,RSS       IS THIS A ZERO LENGTH RECORD? 
      JMP NEXT      YES, IGNORE IT
      STA LENX      SET DATA LENGTH FOR DVR CALL
      LDB DBUF+1    GET DATA ADDRESS
      STB ISTAT     CBL GETS IT AS 1 WORD REQUEST 
      INA 
      CMA,INA 
      STA CNTR      WORD COUNTER. 
      LDB DBFAD     BUFFER ADDRESS. 
      CLA 
CKSML ADA 1,I       ADD UP THE WORDS. 
      INB 
      ISZ CNTR
      JMP CKSML 
      CPA 1,I       COMPARE CHECKSUMS.
      RSS 
      JMP CKSME     NOT EQUAL.
* 
*  CHECKSUM OK, SETUP TO WRITE THIS RECORD
      LDA LU        GET LU
      IOR ZB300     SET 'PROGL' FLAG SO DVR SENDS 1 WRD 
      STA CONWD         ('Z' BIT SET ALSO)
      LDA CURAD,I 
      AND MSKLU     INITIALIZE RETRY COUNT
      STA CURAD,I 
* 
*  NOW DO CLASS I/O WRITE/READ TO DRIVER
* 
      JSB EXEC
      DEF *+8 
      DEF D20N      NO ABORT BIT IS SET 
      DEF CONWD     WRITE DATA
      DEF DBUF+2    DATA BUFFER ADDR
      DEF LENX      BUFFER LENGTH 
      DEF RQBUF     PROGL REQUEST BUFFER: ADDR/LU/SEQ#
      DEF D3
      DEF ICLAS     WRITE IT ON PROGL'S CLASS 
      RSS           ERROR 
*  NOW GO INTO SUSPEND ON PROGL'S CLASS UNTIL A DRIVER WRITE COMPLETES
* OR A NEW REQUEST IS RECEIVED. 
      JMP PGET
      JSB PRFAL     CLASS-IO ERROR
      DEF .CLSR 
      JMP PGET      GO GET NEW REQUEST
* 
* 
*  ENTER HERE WHEN END OF DOWNLOAD FILE IS DETECTED 
*  RETURN GOOD STATUS FOR A SUCCESSFUL DOWNLOAD 
* 
EOFND EQU * 
      LDA #PRLU     DOES USER WISH
      SZA,RSS         ANNOUNCEMENTS?
      JMP EOFN1     NO. 
      STA LUPRN 
      LDA DCBAD     GET ADDRESS OF
      ADA D144        FILE # ENTRY
      LDB 0,I 
      JSB GFNAM     CONVERT FILE NUMBER TO FILE NAME
      LDA @SUC      MOVE 'WAS SUCCESSFUL' TO PRINT BUFFER 
      LDB @RSLT 
      MVW D8
      JSB EXEC
      DEF *+8 
      DEF D18N
      DEF LUPRN 
      DEF MSG2
      DEF MSG2L 
      DEF D0
      DEF D4
      DEF ICLAS 
      NOP 
EOFN1 EQU * 
      JSB CLSE      CLOSE DOWNLOAD FILE 
      CLA           0= GOOD DOWNLOAD
* 
TERM  STA ISTAT     SET STATUS FOR TRANSMISSION 
      LDA LU
      IOR ZB300 
      STA CONWD     SET DVA65 CONTROL WORD
* 
      JSB EXEC      WRITE FINAL REQUEST 
      DEF *+8 
      DEF D20N      CLASS WRITE/READ TO COMM DRIVER 
      DEF CONWD 
      DEF DBUF
      DEF ZERO      NO DATA 
      DEF RQBUF 
      DEF D3
      DEF ICLAS     PROGL CLASS NUMBER
      NOP 
* 
*  THIS DOWNLOAD IS OVER
*  CLEAN OUT DOWNLOAD TABLE ENTRY AND GIVE SPACE TO 
*  ANY ENTRY FOUND IN WAITING QUEUE 
* 
      CLA 
      STA CURAD,I   SET DOWNLOAD ENTRY AS AVAILABLE 
      LDB WAITA 
      LDA NQUE
      STA CNTR      COUNTER= -# OF WAITQ ENTRIES
CKQUE LDA 1,I 
      SZA           SKIP IF SLOT EMPTY
      JMP ACTIV     OTHERWISE, ACTIVATE IT
      ADB D2
      ISZ CNTR
      JMP CKQUE 
      JMP PGET      NOTHING QUEUED, GO TO GET SUSPEND 
* 
*  NOW ACTIVATE A WAITING DOWNLOAD REQUEST FROM THE WAIT QUEUE USING
*  THE ACTIVE DOWNLOAD TABLE SPACE WHICH WAS JUST MADE AVAILABLE
* 
ACTIV STA CURAD,I   MOVE LU TO TABLE ENTRY JUST CLEARED 
      STA LU         AND PUT IT IN "LU" TOO !!! 
      CLA 
      STA 1,I       CLEAR WAIT QUEUE ENTRY
      INB 
      LDB 1,I       PICKUP FILE # AND START DOWNLOADING IT
      JMP NEWLD 
      HED PROGL SUBROUTINES & DATA AREA  * (C) HEWLETT-PACKARD CO 1979
* 
*  THIS SUBROUTINE SEARCHES FOR A DOWNLOAD TABLE ENTRY FOR
*  THE PASSED LU. RETURNS TO P+1 IF NOT FOUND, OTHERWISE P+2
* 
SRCH  NOP 
      LDA NACTV 
      STA CNTR      - # OF ACTIVE ENTRIES ALLOWED 
      CLA           INITIALIZE ADDR OF EMPTY SLOT 
      STA TPNT
      LDB TABAD     ADDR OF DOWNLOAD TABLE
SNXT  LDA 1,I       PICKUP LU OF THIS ENTRY 
      AND MSKLU     MASK POSSIBLE RETRY COUNT 
      CPA LU        DOES THIS ONE MATCH LU? 
      JMP SRCHX     YES, FOUND DOWNLOAD ENTRY 
      IOR TPNT      NO, IS THIS THE 1ST EMPTY SLOT? 
      SZA,RSS       SKIP IF EMPTY SLOT ALREADY FOUND
      STB TPNT      STORE ADDR OF 1ST EMPTY SLOT
      ADB TLENT     BUMP TABLE POINTER
      ISZ CNTR
      JMP SNXT      TRY NEXT
*  LU NOT IN ACTIVE TABLE 
      LDB TPNT      RETURN 1ST EMPTY SLOT INSTEAD 
      RSS           RETURN +1 
* 
*  FOUND AN ENTRY IN THE ACTIVE DOWNLOAD TABLE FOR THIS LU
SRCHX ISZ SRCH      RETURN+2
      STB CURAD     SET ADDRESS OF ENTRY
      INB 
      STB SEQAD      & ADDRESS FOR SEQ #
      INB 
      STB DCBAD      & ADDRESS FOR DCB
      JMP SRCH,I    RETURN
* 
*  SUBROUTINE TO GET A WORD FROM SYSTEM AVAILABLE MEMORY
LODWD NOP 
MOD1  JMP LDA       NOP HERE IF DMS 
      XLA 1,I 
      JMP LODWD,I 
LDA   LDA 1,I 
      JMP LODWD,I 
* 
*  RELEASE CLASS BUFFER 
* 
RLEAS NOP 
      JSB EXEC      DO DUMMY CLASS GET
      DEF *+5 
      DEF D21 
      DEF CLAS2 
      DEF BUFR
      DEF ZERO
      JMP RLEAS,I 
* 
*  CLOSE DOWNLOAD FILE, UNLESS IT IS OPEN FOR ANOTHER DOWNLOAD
* 
CLSE  NOP 
*  SET FILE # ENTRY TO INDICATE CLOSED FILE 
      CCA 
      ADA CURAD 
      ADA TLENT 
      LDB 0,I       SAVE FILE 
      STB FLNUM      NUMBER 
      LDB D12N      CLEAR 
      STB 0,I        ENTRY
*  CHECK TO SEE IF THE FILE IS STILL OPEN 
      LDA NACTV     SET UP LOOP 
      STA CNTR       COUNTER = - # ENTRIES
      CCA           POINT TO FIRST
      ADA TABAD      FILE NUMBER ENTRY
BUMP2 ADA TLENT 
      LDB 0,I       GET FILE NUMBER 
      CPB FLNUM     IF = CURRENT ONE, 
      JMP CLR9         GO DUMMY UP DCB
      ISZ CNTR      MORE TO SEARCH? 
      JMP BUMP2       YES--STAY IN LOOP 
*  CURRENT NUMBER NOT FOUND. CLOSE FILE FOR REAL
      JSB CLOSE 
      DEF *+3 
      DEF DCBAD,I 
      DEF IERR
      JMP CLSE,I
*  CLEAR WORD 9 OF DCB SO FMP THINKS IT'S CLOSED
CLR9  CLA 
      LDB DCBAD 
      ADB D9
      STA 1,I 
      JMP CLSE,I
* 
*  DOWNLOAD TABLE IS FULL, PUT THIS REQUEST IN WAITING QUEUE
* 
FULL  LDA NQUE
      STA CNTR      -QUEUE TABLE SIZE 
      CLA 
      STA TPNT
      LDB WAITA     ADDR OF WAIT QUEUE
CKQ   LDA 1,I       GET LU OF THIS ENTRY
      CPA LU        DOES IT MATCH THIS REQUEST
      JMP BLDQ      YES, THEN SET NEW FILE #
      IOR TPNT      CHECK IF THIS IS 1ST EMPTY SLOT IN QUEUE
      SZA,RSS       SKIP IF NOT 
      STB TPNT      SAVE ITS ADDRESS
      ADB D2        BUMP QUEUE POINTER
      ISZ CNTR
      JMP CKQ       EXAMINE NEXT ENTRY
* 
*  WE NOW KNOW THAT THIS LU WASN'T ALREADY IN WAIT QUEUE
      LDB TPNT      GET ADDRESS OF 1ST EMPTY SLOT 
      SZB,RSS       WERE THERE ANY EMPTIES? 
      JMP PGET      NO, WE'RE IN TROUBLE
      LDA LU        LU
      STA 1,I       INTO 1ST WORD OF WAIT QUEUE ENTRY 
* 
BLDQ  INB 
      LDA BUFR+1    FILE #
      STA 1,I       GOES INTO 2ND WORD
      JMP PGET      GO BACK TO SUSPEND ON GET 
* 
ERR1  CCA           ERROR IN FILE OPEN
      JMP TERM
*                   HERE WHEN FILE-READ ERROR OCCURS
* 
ERR2  EQU * 
      LDB #PRLU     SHOULD WE BOTHER PRINTING ERROR MESSAGE?
      SZB,RSS 
      JMP ER.2      NO
      STB LUPRN 
      CMA,INA       MAKE ERROR CODE NEGATIVE SO CNUMD CAN CONVERT 
      STA IERR
      JSB CNUMD 
      DEF *+3 
      DEF IERR
      DEF .FILE 
      JSB EXEC      PRINT FILE-READ ERROR 
      DEF *+8 
      DEF D18N
      DEF LUPRN 
      DEF .RDER 
      DEF D15 
      DEF D0
      DEF D4
      DEF ICLAS 
      NOP 
      JSB PRFAL 
      DEF .FAIL 
ER.2  EQU * 
      JSB CLSE      ERROR IN FILE READ, DO CLOSE
      LDA M2
      JMP TERM
      SPC 2 
ERR3  JSB CLSE      DRIVER ERROR, DO CLOSE
      LDA M3
      JMP TERM
      SPC 2 
*     HERE ON CHECKSUM ERROR ON READ
* 
CKSME EQU * 
      JSB PRFAL 
      DEF .CKER 
      JMP ER.2
      SPC 2 
*     SUBROUTINE TO CONVERT FILE NUMBER INTO ASCII FILE NAME. 
* 
*     CALLING SEQUENCE: 
*     LDB <FILE NUMBER> 
*     JSB GFNAM 
*     <RETURN>
* 
* 
GFNAM NOP 
      RRL 4         DUAL ROTATE LEFT 4
      AND D7
      IOR ASCP0     FORM ASCII OF 1ST 2 CHARS 
      STA NAME
      CLA 
      RRL 3         POSITION 3RD OCTAL DIGIT
      ALF,RAL       MOVE TO LHW 
      RRL 3         GET 4TH DIGIT 
      IOR ASC00     ASCII FOR 3RD & 4TH DIGITS
      STA NAME+1
      CLA 
      RRL 3         5TH DIGIT 
      ALF,RAL       TO LHW
      RRL 3         GET 6TH & FINAL DIGIT 
      IOR ASC00     CONVERT TO ASCII
      STA NAME+2
      LDA #PRLU     USER WISH ANNOUNCEMENT? 
      SZA,RSS 
      JMP GFNAM,I   NO,RETURN 
      STA LUPRN 
      JSB EXEC      YES, INCLUDE TIME-OF-DAY
      DEF *+3 
      DEF D11 
      DEF DBUF
      JSB CNUMD     CONVERT DAY NUMBER
      DEF *+3 
      DEF DBUF+4
      DEF .DAY
      LDB AM        CONVERT 24-HR TIME TO 12-HR TIME
      LDA DBUF+3
      ADA M12       PM? 
      SSA 
      JMP GFNM1     NO. 
      SZA,RSS       12 NOON?
      LDA D12       YES 
      STA DBUF+3
      LDB PM
GFNM1 EQU * 
      STB AMPM
      LDA DBUF+3    GET HOUR AGAIN
      SZA,RSS       ZERO? 
      LDA =D12      YES 
      STA DBUF+3
      JSB KCVT      CONVERT HOUR NUMBER 
      DEF *+2 
      DEF DBUF+3
      STA .HR 
      JSB KCVT      CONVERT MINUTES 
      DEF *+2 
      DEF DBUF+2
      STA .MIN
      JMP GFNAM,I   RETURN TO CALLER
      SPC 2 
*     SUBROUTINE TO HANDLE THE REPETITIVE PARTS OF PRINTING 
*     A "DOWN-LOAD FAILED" MESSAGE. 
* 
*     CALLING SEQUENCE: 
*     JSB PRFAL 
*     DEF <REASON FOR FAILURE MESSAGE>
*     <RETURN>
* 
PRFAL NOP 
      LDA PRFAL,I   GET ADDRESS OF MESSAGE
      ISZ PRFAL     BUMP RETURN 
      LDB #PRLU     ARE WE SUPPOSED TO
      SZB,RSS        PRINT A MESSAGE? 
      JMP PRFAL,I   NO, RETURN TO CALLER
      STB LUPRN     SAVE LU 
      LDB @RSLT     MOVE REASON FOR FAILURE INTO
      MVW D8          "DOWN LOAD OF..." MESSAGE AREA
      LDA DCBAD     GET ADDRESS OF
      ADA D144        FILE NUMBER 
      LDB 0,I       GET FILE NUMBER 
      JSB GFNAM     CONVERT THIS TO ASCII & ALSO FORMAT TIME-OF-DAY 
      JSB EXEC      PRINT MESSAGE 
      DEF *+8 
      DEF D18N      USE CLASS-I/O 
      DEF LUPRN 
      DEF MSG2
      DEF MSG2L 
      DEF D0
      DEF D4        LENGTH OF 4 SO WE CAN SEPARATE
      DEF ICLAS        OUR OWN PRINTOUTS FROM 
      NOP              XMISSION LINE COMPLETIONS
      JMP PRFAL,I   RETURN TO CALLER
      SPC 2 
* 
*  DATA AREA
* 
      SUP 
MSG1  ASC 9, INITIATING VIA LU
.LU.  BSS 3 
MSG2  ASC 9, DOWNLOAD OF FILE:
NAME  BSS 3 
      ASC 2,::- 
.DLU  ASC 1,        STORAGE FOR FILE DISC LU HERE 
      ASC 1,: 
.TYP  ASC 1,        STORAGE FOR FILE TYPE HERE
      OCT 6412      CARRIAGE RETURN-LINEFEED
      ASC 4, AT DAY 
.DAY  BSS 3 
      ASC 1,, 
.HR   NOP 
      ASC 1, :
.MIN  NOP 
AMPM  BSS 1         'AM' OR 'PM'
* 
.RSLT BSS 8 
MSG1L ABS *-MSG1-8
MSG2L ABS *-MSG2-1
* 
@RSLT DEF .RSLT 
@SUC  DEF *+1 
      ASC 8, WAS SUCCESSFUL 
.FAIL ASC 8, HAS FAILED.
.ABR1 ASC 8, WAS ABORTED
.FAL1 ASC 8, FAILED:RE-Q ERR
.CLSR ASC 8, FAILED:CLASS ER
.RDER ASC 12,/PROGL:FILE READ ERROR-
.FILE BSS 3 
.CKER  ASC 8, FAILED:CKSM ERR 
MSG3  ASC 11,/PROGL:FMP OPEN ERROR- 
FILER BSS 3 
MSG3L ABS *-MSG3
LUPRN NOP 
AM    ASC 1,AM
PM    ASC 1,PM
BFADR NOP 
FLNUM NOP 
RQLEN NOP 
IERR  NOP 
ICLAS NOP 
CLAS2 NOP 
EQT#  NOP 
ERCNT NOP 
TPNT  NOP 
CNTR  NOP 
LENX  NOP 
CONWD NOP 
POOLS NOP 
CURAD NOP 
SEQAD NOP 
*  3 WORD REQUEST AREA
RQBUF EQU * 
ISTAT NOP 
LU    NOP 
SEQ#  NOP 
* 
D1    DEC 1 
D2    DEC 2 
D18N  OCT 100022    NO-ABORT CLASS-I/O 'WRITE' REQUEST CODE 
D3    DEC 3 
D4    DEC 4 
D7    DEC 7 
D8    DEC 8 
D9    DEC 9 
D11   DEC 11
D12   DEC 12
D15   DEC 15
D21   DEC 21
D144  DEC 144 
M1    DEC -1
M2    DEC -2
M3    DEC -3
M5    DEC -5
M12   DEC -12 
M20   DEC -20 
B77   OCT 77
B170  OCT 170 
ZB300 OCT 10300     'Z' BIT + 'PROGL' FLAG FOR "WRITE" OPERATION
B377  OCT 377 
D12N  OCT 100014
D20N  OCT 100024
RTBIT OCT 1000      INCREMENT FOR RETRY FIELD 
MSKLU OCT 777       MASK FOR LU WORD
MSK14 OCT 137777
ICNWD OCT 150301
* 
TLENT DEC 147       SIZE OF DOWNLOAD TABLE ENTRY
NACTV ABS -#ACTV
NQUE  ABS #ACTV-#TERM 
MAXL  DEC 255 
ASC00 ASC 1,00
ASCP0 ASC 1,P0
* 
DBFAD DEF DBUF+1
TABAD DEF DT        ADDR OF DOWNLOAD TABLE
                                                                                                                    