ASMB,R,L,C
      HED NPRGL 91700-16103 REV A * (C) HEWLETT-PACKARD CO. 1976
      NAM NPRGL,2,30 91700-16103 REV A 760323 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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 2 
* 
*********************************************** 
* 
*NPRGL              PROGRAM TO DO ABSOLUTE DOWN LOADING 
* 
*SOURCE PART #      91700-18003 REV B 
* 
*REL PART #         91700-16003 REV B 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      8-28-74 
* 
*MODIFIED BY:       CHUCK WHELAN
* 
*DATE MODIFIED:     MARCH 1976
* 
************************************************
      SPC 1 
      SUP 
      SPC 2 
* 
*     PROGRAM TO DO DOWN LINK LOADING ON UP TO
*     MAXN TERMINALS. WHERE MAXN IS THE NUMBER OF TERMINALS 
*     WHICH CAN OPERATE AT ANY ONE TIME 
*     REMEMBER EACH TERMINAL TAKES 173 WORDS!!! 
* 
      SPC 2 
*     DEFINE ENTRY POINTS 
      SPC 2 
*     DEFINE EXTERNALS
      SPC 1 
      EXT EXEC,READF,POSNT,CLOSE
      EXT OPEN
      EXT D65SV 
      IFN 
      EXT DBUG
      XIF 
      SPC 2 
*     DEFINE A AND B REG
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 3 
* 
*     STATUS AND ERROR WORD COMMENTS
* 
*STATUS WORD        ERROR WORD
*0    =NEW REQ      DON'T CARE
*1    =DATA COMMING STARTING ADDRESS OF RECORD
*2    =ID SEG COMMING CONTENTS OF LOCATION 2
*3    =NO ID SEQ    0=NO STARTING ADDRESS OR LOCATION 2 
*-2   FMG ERROR     FMG ERROR CODE
*-3   BUSY          0...TRY LATTER
*-4   LOST DCB      -103...IN BIG TROUBLE 
* 
      SKP 
* 
*     PROGRAM STARTS HERE 
* 
PROGL LDA B,I       GET CLASS NUMBER
      STA CLSNM     SAVE CLASS NUMBER 
      IFN 
      SPC 1 
      SZA           DO THEY WANT DEBUG
      JMP PRGL1 
      JSB DBUG
      DEF *+1 
      JSB EXEC
      DEF *+4 
      DEF D6
      DEF D0
      DEF D1
      JMP PROGL 
      XIF 
      SPC 2 
PLOS0 BSS 0 
PRGL1 JSB EXEC      DO A GET CALL...WAIT FOR SOMETHING
      DEF *+5 
      DEF D21       CODE FOR A GET CALL 
      DEF CLSNM     CLASS # 
      DEF RBUF      REQUEST BUFFER
      DEF D35       REQUEST BUFFER LENGTH 
* 
      LDA RLU       GET COMM. LU
      AND MSK1      KEEP ONLY LOW 6 BITS
      STA RLU 
* 
*     WHEN WE GET HERE SOMEONE WANTS SOMETHING
* 
      LDA DCBN      GET DCB NUMBER..IF ZERO 
      SZA           IT IS A NEW REQUEST 
      JMP PLOS2     NOT A NEW REQUEST 
* 
      JSB ALOC      ALLOCATE A DCB
* 
      JSB OPEN      OPEN IT 
      DEF *+7 
      DEF DCBN,I
      DEF FERR
      DEF PNAM      FILE NAME 
      DEF D0
      DEF SC
      DEF LU
* 
      LDA FERR      ANY ERRORS? 
      CPA D7        MUST BE FILE TYPE 7 
      CLB,RSS       OK
      JMP ERRM2     DO ERROR RETURN 
      STB DNFLG     CLEAR OUT DONE FLAG 
* 
*     AT THIS POINT THE DCB IS DEFINED
*     THE FILE IS OPENED AND WE ARE READY TO DO 
*      OUR THING. 
* 
PLOS2 LDA DNFLG     SEE IF WE ARE DONE
      SZA           DONE? 
      JMP DONE      YES 
      JSB LBUF      NO...LOAD UP BUFFER 
      STB STAT      SAVE THE FILE STATUS
      JSB STLN      SET LENGTH OF REPLY PARMB 
      LDA D1        SET STATUS MORE COMMING 
      STA STAT
      SZB           DONE? 
      ISZ DNFLG     YES...SET DONE FLAG FOR NEXT TIME 
      LDA SADD      GET STARTING ADDRESS
      STA STRTA     SET IN STARTING ADDRESS 
      LDA DLEN      GET LENGTH OF DATA BUFFER 
      STA LNGH
      SZA,RSS       IF LENGTH IS ZERO...DONE
      JMP DONE      ZERO...DONE 
      LDA RBUF      GET STREAM TYPE 
      IOR BIT14 
      STA RBUF      SAVE REPLY STREAM TYPE
      LDA RLU       GET COMM. LU
      IOR B120      SET SEND REQ. AND DATA & Z BIT
      STA CNWD
* 
* 
      JSB D65SV     SEND DATA TO TERMINAL 
      DEF *+7 
      DEF IRWW      WRITE 
      DEF CNWD
      DEF RBUF
      DEF RBUFL 
      DEF DBUF      DATA BUFFER 
      DEF DLEN      DATA LENGTH 
* 
      JSB CLOS      ERROR, CLOSE & DEALLOCATE DCB 
      JMP PLOS0     TERMINATE AND WAIT
* 
*      SUBROUTINE TO CLOSE FILE & DEALLOCATE DCB
* 
CLOS  NOP 
      JSB CLOSE     CLOSE FILE
      DEF *+3 
      DEF DCBN,I
      DEF FERR
      JSB DALOC     DE-ALLOCATE THE DCB 
      JMP CLOS,I    RETURN
      SKP 
* 
*     ROUTINE TO LOAD THE BUFFER FROM A FILE
*     CALLING SEQUENCE
*     JSB LBUF      READ THE BUFFER 
*     UPON RETURN B REG WILL CONTAIN THE STATUS 
* 
LBUF  NOP 
      CLA 
      STA CADD      CLEAR CURRENT ENDING ADDRESS
      STA SADD      CLEAR STARTING ADDRESS
      STA DLEN      CLEAR OUT LENGTH
      STA FILER     SET FOR NO FILE ERRORS
* 
LBUF0 JSB READF     READ A RECORD 
      DEF *+6 
      DEF DCBN,I
      DEF FERR
      DEF RDBUF 
      DEF D60 
      DEF TEMP1 
      LDA TEMP1     GET LENGTH
      CPA M1        DONE? 
      JMP LBUFB     YES 
* 
*     DO CHECKSUM CHECKING
* 
      LDA RLEN      GET LENGTH
      ALF,ALF 
      CMA           NEGATE...INCLUDE STARTING ADDRESS AS LENGTH 
      STA CKLEN 
      LDA STADA     GET STARTING ADDRESS
      CLB           CLEAR OUT FOR LOOP
LBUF5 ADB A,I       DO CHECKSUM 
      INA 
      ISZ CKLEN     DONE? 
      JMP LBUF5     NO
      CPB A,I       DO THEY MATCH 
      JMP LBUF6     YES 
      ISZ FILER     NO...SET FOR ERROR
      JMP LBUFB     AND TERMINATE 
* 
LBUF6 LDA STADD     GET BUFFER ADDRESS
      CPA D2        IS IT PART OF THE ID SEGMENT? 
      JMP IDFIX     YES 
      LDA CADD      FIRST TIME THRU?
      SZA 
      CPA STADD     IS ADDRESS NEXT RECORD? 
      JMP LBUFC     YES 
      LDB SADD      GET STARTING ADDRESS
      CMB,INB       NEGATE IT 
      CMA,INA       NEGATE ENDING ADDRESS 
      ADA STADD     SEE IF WITHIN EXSITING BUFFER 
      ADB STADD 
      SSA 
      SSB 
      RSS           NOT WITHIN PREVOUS CODE 
      JMP LBUFC     IS, SAVE IT 
      SPC 1 
LBUFP JSB POSNT     HERE IF BUFFER FULL, OR BREAK IN CODE 
      DEF *+4 
      DEF DCBN,I
      DEF FERR
      DEF M1
      LDB FILER     SET FOR MORE TO COME
      JMP LBUF,I    AND RETURN
      SPC 2 
LBUFB JSB CLOSE     HERE IF EOF REACHED 
      DEF *+3 
      DEF DCBN,I
      DEF FERR
      LDB FILER     CHECK IF ANY ERRORS 
      CMB           NEGATE...IF WAS ZERO..NO ERROR, OTHERWISE FILE ERROR
      JMP LBUF,I    AND RETURN
      SPC 3 
LBUFC LDA CADD      GET CURRENT ADDRESS 
      LDB STADD     FIRST RECORD? 
      SZA,RSS 
      STB SADD      YES...SET IN STARTING ADDRESS 
      LDA RLEN      GET RECORD LENGTH 
      ALF,ALF 
      AND B377      GET LENGTH
      STA RLEN      SAVE LENGTH 
      ADA DLEN      GET LENGTH AFTER THE MOVE 
      STA B         SAVE FOR THE MOMENT 
      ADA MBUFS     SEE IF WE HAVE OVERFLOWED THE 
      SSA,RSS       DATA BUFFER 
      JMP LBUFP     YES WE HAVE 
      STB DLEN      SAVE LENGTH 
      LDA RLEN      GET LENGTH AGAIN
      ADA STADD     GET ENDING ADDRESS+1
      STA B         SAVE FOR AWHILE 
      CMA,INA       NEGATE IT 
      ADA CADD      SEE IF GREATER THAN CURRENT ENDING
      SSA 
      STB CADD      YES...SAVE NEW ENDING ADDRESS 
      LDA SADD      GET BEGINING
      CMA,INA       GET DISPLACEMENT INTO BUFFER
      ADA STADD 
      ADA DBUFA     GET STARTING ADDRESS FOR MOVE 
      STA STADD     SAVE ADDRESS
      LDA RLEN      GET LENGTH AGAIN
      CMA,INA       NEGATE FOR LOOP COUNT 
      STA RLEN
      LDB SDBA      GET STARTING ADDDRESS OF INPUT BUFFER 
LBUFD LDA B,I 
      STA STADD,I   SAVE DATA WORD
      INB           GET NEXT ADDRESS
      ISZ STADD 
      ISZ RLEN      DONE? 
      JMP LBUFD     NO
      JMP LBUF0     DONE...GET ANOTHER RECORD 
      SPC 2 
IDFIX DLD FWRD      GET TWO WORDS 
      DST CAIDS,I   SAVE WORDS
      ISZ CAIDS     GET NEXT ADDRESS
      ISZ CAIDS 
      ISZ CLIDS     INCREMENT RECORD COUNT
      JMP LBUF0     GET ANOTHER REOCRD
      SKP 
* 
*     SUBROUTINE TO ALOCATE A DCB 
*     CALLING SEQUENCE
*     JSB ALOC
* 
ALOC  NOP 
* 
*     BEFORE WE ALOCATE A DCB, CHECK IF ONE IS
*     ALREADY ALOCATED
* 
      LDA SATA      GET ADDRESS OF ACTIVE SATELITE TABLE
      STA TEMP1     SAVE IN UP COUNTER
      LDA MMAXS     GET MAX # OF ENTRIES
      INA 
      STA TEMP2     SAVE IN DOWN COUNTER
      CLA           SET UP FOR TABLE DISPLACEMENT 
      STA TEMP3 
      LDA RLU       GET REMOTE LU # 
ALOC4 CPA TEMP1,I   IS THERE A MATCH
      JMP ALOC5     YES...DCB ALOCATED FOR TERMINAL ALREADY 
      ISZ TEMP1     NO...GET NEXT ENTRY 
      ISZ TEMP3 
      ISZ TEMP2     DONE? 
      JMP ALOC4     NO...CONTINUE 
* 
*     TERMINAL DOESN'T ALREADY HAVE A DCB...TRY TO FIND ONE 
* 
      LDA DCBBA     GET ADDRESS OF DCB AVAILABLE TABLE
      STA TEMP1     SAVE IN TEMP LOCATION 
      LDA MMAXS     GET MAX # OF ENTRIES
      STA TEMP2     SAVE IN DOWN COUNTER
      CLA           GET A ZERO
      STA TEMP3     SAVE AS MULT. FACTOR
ALOC1 ISZ TEMP2     DONE? 
      JMP ALOC3     NO...CONTINUE 
      LDB M3        YES...NO ROOM 
      JMP TERM      TELL OTHER SIDE TO TRY LATER
ALOC3 LDA TEMP1,I   GET CONTENTS OF TABLE 
      SZA,RSS       IS THERE SOMETHING THERE? 
      JMP ALOC2     NO...GOOD FOUND A HOME!!! 
      ISZ TEMP1     GET NEXT ADDRESS
      ISZ TEMP3     INCREMENT MULT COUNT
      JMP ALOC1     CONTINUE
* 
*     HERE IF WE HAVE ROOM
* 
ALOC2 LDA TEMP3     GET MULT FACTOR 
      MPY DCBSZ     GET DISPLACEMENT FROM FIRST 
      ADA DCBA      ADDRESS OF AVAILABLE DCB
      STA TEMP1,I   SAVE IN TABLE TO HOLD A PLACE 
      STA DCBN      SAVE IN PARMB 
      ISZ CALOC     INCREMENT # OF ACTIVE TERMINALS 
      LDA TEMP3     GET DISPLACEMENT
      ADA SATA      ADD FOR SATELLITE TABLE ENTRY 
      LDB RLU       GET REMOTE LU 
      STB A,I       SAVE PLACE IN TABLE 
      JMP ALOC6     SET UP THE ID SEGEMENT
      SPC 3 
* 
*     TERMINAL ALREADY HAS A DCB...CLOSE IT AND REUSE IT
* 
ALOC5 LDA TEMP3     GET DISPLACEMENT
      ADA DCBBA     GET TO DCB ADDRESS
      LDA A,I       GET DCB ADDRESS 
      STA DCBN      SAVE DCB ADDRESS IN PARMB 
      JSB CLOSE     CLOSE CURRENTLY OPEN DCB
      DEF *+3 
      DEF DCBN,I
      DEF FERR
ALOC6 LDA DCBN      GET DCB ADDRESS 
      ADA D144      GET TO ID SEG ADDRESS 
      STA CAIDS 
      LDB MIDLN     GET LOOP OCUNT
      STB CLIDS 
      CLB 
      STB A,I       CLEAR OUT ID SEG
      INA 
      ISZ CLIDS 
      JMP *-3 
      JMP ALOC,I    AND RETURN
      SKP 
* 
*     SUBROUTINE TO DALOCATE A DCB
*     CALLING SEQUENCE
*     JSB DALOC 
* 
DALOC NOP 
      LDA DCBBA     GET ADDRES OF DCB ACTIVE TABLE
      STA TEMP1     SAVE IN TEMP LOCATION 
      LDA MMAXS     GET MAX # OF ENTRIES
      STA TEMP2     SAVE IN TEMP LOCATION 
      LDA SATA      GET ADDRESS OF SATELLITE OPEN TABLE 
      STA TEMP3 
DALC1 ISZ TEMP2     GONE THRU TABLE?
      JMP DALC2     NO....GOOD
      LDB M4        WE IN BIG TROUBLE...SHOULD NEVER GET HERE 
      JMP TERM      UNKNOWN DCB 
DALC2 LDA TEMP1,I   GET ADDRESS IN TABLE
      CPA DCBN      THE SAME? 
      JMP DALC3     YES...DEALOCATE IT
      ISZ TEMP3     GET TO NEXT SATELLITE ENTRY 
      ISZ TEMP1     GET NEXT BUFFER ADDRESS 
      JMP DALC1     GO TRY AGAIN
* 
*     HERE FOR MATCH CONDITION
* 
DALC3 CLA           GET A ZERO
      STA TEMP1,I   CLEAR OUT TABLE LOCATION
      STA TEMP3,I   CLEAR OUT SATELLITE ENTRY 
      STA DCBN      CLEAR OUT DCB POINTER 
      JMP DALOC,I   RETURN
      SKP 
* 
*     SUBROUTINE TO SEND A REPLY TO THE TERMINAL
*     CALLING SEQUENCE
*     JSB WRPLY 
* 
WRPLY NOP 
      JSB STLN      SET LENGTH OF REPLY PARMB 
      LDA RBUF      GET STREAM TYPE 
      IOR BIT14     SET FOR REPLY 
      STA RBUF
      JSB D65SV     SEND REPLY
      DEF *+7 
      DEF IRWW      WRITE 
      DEF RLU       DATA ONLY 
      DEF RBUF      REQ. BUFFER 
      DEF RBUFL     LENGTH
      DEF DUMMY 
      DEF DUMMY 
* 
      JSB CMER      ERROR RETURN
      JMP WRPLY,I   RETURN
      SPC 4 
* 
ERRM2 JSB CLOS      CLOSE & DEALLOCATE DCB
      LDB M2
* 
*     HERE TO TERMINATE ON AN ERROR CONDITION 
*     B REG=STATUS
* 
TERM  STB STAT      SAVE STATUS 
      LDA FERR
      CPB M3        BUSY? 
      CLA           YES 
      CPB M4        DCB LOST? 
      LDA M103      YES...BIG TROUBLE 
      STA FERR
      JSB WRPLY     SEND ERROR REPLY
      JMP PLOS0     AND WAIT
      SPC 4 
* 
*     ROUTINE TO SEND ID SEGMENT WHEN DONE
* 
DONE  LDA DCBN
      ADA D144
      STA IDSEG     ADDR OF ID SEG DATA 
      JSB DALOC     DEALLOCATE THE DCB
      LDA CAIDS 
      ADA M2
      DLD A,I       GET WORDS 2 AND 3 
      DST PNAM
      LDB D3        INCASE NO ID SEGMENT
      LDA CLIDS     GET # OF 2/3 ENTRIES
      SZA,RSS       STARTING ADDRESS? 
      STA PNAM+1    NO...SET TO ZERO
      CMA,INA 
      ADA D1        IF ONLY ONE RECIEVED... NO ID SEQMENT 
      SSA,RSS 
      JMP TERM      NO ID SEQ 
      LDA D2        SET FOR ID SEG COMMING
      STA STAT
      LDA IDLNH     GET LENGTH OF ID INFO 
      STA LNGH      SAVE IN LENGTH WORRD
      LDA RBUF
      IOR BIT14     SET FOR REPLY 
      STA RBUF
      LDA RLU 
      IOR B120      SEND REQUEST AND DATA + Z BIT 
      STA CNWD
      JSB STLN      SET LENGTH OF REPLY PARMB 
      JSB D65SV     SEND ID SEQMENT 
      DEF *+7 
      DEF IRWW      WRITE 
      DEF CNWD
      DEF RBUF
      DEF RBUFL     REQ. LENGTH 
IDSEG NOP           ID SEGMENT ADDRESS (DATA) 
      DEF IDLNH     DATA LENGTH 
* 
      JSB CMER      ERROR RETURN
* 
      JMP PLOS0     AND TERMINATE 
      SPC 3 
CMER  NOP 
      DST ERVAL 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF D1
      DEF ERMS
      DEF ERML
* 
      JMP CMER,I
      SPC 3 
STLN  NOP           THIS ROUTINE SETS THE LENGTH OF THE REPLY 
      DST SAVAB     SAVE THE REGISTERS
      LDA RBUF      GET WORD 0 OF PARMB 
      AND MSK2      ISOLATE THE F BIT 
      LDB D35 
      SZA,RSS       IS THE BIT SET ?
      LDB D25       NO, SET FOR 25 WORDS (OLD PARMB)
      STB RBUFL     SAVE
      DLD SAVAB     RESTORE THE REGISTERS 
      JMP STLN,I    RETURN
      SPC 3 
ERMS  ASC 9,NPRGL: COMM ERROR 
ERVAL BSS 2 
ERML  DEC 11
      SKP 
* 
*     TEMP VALUES,CONSTANTS,BUFFERS, WHAT EVER
* 
MAXN  EQU 2         MAX # OF OPEN TERMINALS 
BUFS  EQU 512       SIZE OF DATA BUFFER 
LNHID EQU 18        LENGTH OF ID SEQMENT INFO 
      SPC 1 
CLSNM NOP           CLASS NUMBER
B377  OCT 377 
BIT14 OCT 40000 
D21   DEC 21
B120  OCT 10200 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D6    DEC 6 
D7    DEC 7 
D25   DEC 25
D35   DEC 35
D60   DEC 60
D144  DEC 144 
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M103  DEC -103
MIDLN ABS 0-LNHID   NEGATIVE LENGTH OF ID SEG INFO
MMAXS ABS 0-MAXN-1  MAX # OF TERMINALS + 1
MBUFS ABS 0-BUFS-1 DATA BUFFER SIZE 
CALOC OCT 0         CURRENT # OF ACTIVE DCB'S 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
CADD  NOP 
SADD  NOP 
SDBA  DEF FWRD
D0    OCT 0 
DBUFA DEF DBUF
DCBBA DEF DCCB
STADA DEF STADD 
CKLEN NOP 
FILER NOP 
DCBA  DEF DCBF
SATA  DEF SAT 
SZDCB EQU 144+LNHID 
DCBSZ ABS SZDCB 
MSK1  OCT 77
MSK2  OCT 4000
CNWD  NOP 
DUMMY OCT 0 
IRWW  OCT 100002
RBUFL NOP 
DLEN  NOP 
IDLNH ABS LNHID 
SAVAB BSS 2 
      SPC 2 
* 
*     HERE WE DEFINE THE PRMB 
* 
.     EQU * 
RBUF  NOP           STREAM ID 
      BSS 1 
STAT  NOP           STATUS
STRTA BSS 0 
FERR  NOP 
LNGH  NOP 
PNAM  NOP           PROGRAM NAME
      BSS 2 
SC    NOP           SECURITY CODE 
DNFLG BSS 0 
LU    NOP           LOGICAL UNIT
DCBN  NOP 
CLIDS NOP           CURRENT # OF 2 WORD TRANSFERS 
CAIDS NOP           CURRENT ADDRESS WITHIN ID SEGMENT 
      SPC 1 
      ORG .         RE POSITION EVERYBODY 
      BSS 24
RLU   NOP           LU WHO CALLED UP
      BSS 10
      SPC 2 
* 
*     INPUT BUFFER FOR READING ABSOLUTE RECORDS 
* 
...   EQU *         DEFINE FOR REORG
RLEN  NOP           LENGTH WORD 
STADD NOP           STARTING ADDRESS WORD 
FWRD  NOP           FIRST DATA WORD 
      SPC 1 
* 
*     REORG AND MAKE BUFFER 60 WORDS LONG 
* 
      ORG ... 
RDBUF BSS 60
      SPC 2 
* 
*     DEFINE SATELLITE OPEN TABLE 
* 
SAT   REP MAXN
      NOP 
      SPC 2 
*     DEFINE DCB TABLE
DCCB  BSS 0 
      REP MAXN
      NOP 
      SPC 2 
*     DEFINE DCB AREA 
DCBF  BSS 0 
      REP MAXN
      BSS SZDCB 
      SPC 2 
*     DEFINE DATA BUFFER
DBUF  BSS 512 
END   EQU * 
      END PROGL 
                                                                                                                                                                                              