ASMB,R,L,C
*     NAME:   SGLDL 
*     SOURCE: 91750-16175 
*     RELOC:  91750-1X175 
*     PGMR:   GERRY BELDEN
* 
*  ***************************************************************
*  * (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 HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
      NAM SEGLD,7 91750-1X175 REV 2013 791003 L 
* 
* 
      ENT SEGLD,SEGRT 
* 
      EXT .ENTR,.MVW,$LIBR,$LIBX,$XQT 
      EXT DOPEN,DREAD,DCLOS,D$OVR 
      SUP 
      SKP 
* 
* 
SEGLD NOP 
      STB XB        SAVE B REGISTER IN CASE NO PARMS PASSED 
* 
      LDA DZERO 
      STA NAMR      RESET PARMS 
      STA IERR
      STA XT1 
      STA XT2 
      STA XT3 
      STA XT4 
      STA XT5 
      LDA SEGLD 
      STA DEGLD     SET PARM ADDR FOR .ENTR 
      JMP ENTD      GO GET PARMS
* 
* 
NAMR  DEF ZERO
IERR  DEF ZERO
XT1   DEF ZERO
XT2   DEF ZERO
XT3   DEF ZERO
XT4   DEF ZERO
XT5   DEF ZERO
* 
DEGLD NOP           DUMMY ENTRY POINT 
ENTD  JSB .ENTR     FETCH CALL PARMS
      DEF NAMR
* 
      LDA NAMR      MUST HAVE 
      CPA DZERO         NAME PARM.
      JMP ERR14           ELSE--PARAM. ERROR
* 
*     IF PARAMETERS PASSED, RETRIEVE ACTUAL VALUES
* 
      LDA XT1       1ST PRAM ADDRESS
      CPA DZERO     ANYTHING PASSED ? 
      JMP NOPAR 
      LDA DM5       YES, GET ALL FIVE 
      STA TEMP
      LDA XDEF      A(PRAM DEFS)
SLOOP LDB A,I       GET DEF 
      LDB B,I       GET VALUE 
      STB A,I       SAVE IT IN PLACE OF DEF 
      INA 
      ISZ TEMP      DONE ?
      JMP SLOOP     NOPE
      SKP 
* 
*     DETERMINE # OF PROGRAM SEGMENTS, IF ANY, AND FIND 
*      SHORT ID OF MATCHING SEGMENT NAME. 
* 
NOPAR LDB $XQT      ID SEGMENT ADDRESS
      ADB D23       FIND # SEGMENTS 
      LDA B,I 
      AND B176K 
      SZA,RSS 
      JMP ERR14     NONE, ERROR 
      ALF 
      RAL,RAL 
      STA TEMP      SAVE # SEGMENTS 
      CMA           NEGATE FOR LOOP COUNT 
      STA NMSEG      & SAVE 
      LDB $XQT      FIND LOW MAIN SO AS TO
      ADB D20        FIND 1ST SHORT ID
      LDB B,I 
      STB TEMP1     SAVE FOR LATER
* 
CHKLP STB IDADR 
      JSB SUM       VERIFY CHECKSUM, NO RETURN
*                                    ON ERROR 
      LDA DM3       INITIALIZE NAME CHECK LOOP
      STA CKLOP 
      LDA NAMR      A(SEG. NAME)
      STA TSTNM 
      LDB IDADR     A(SHORT ID) 
* 
SEG0  LDA B,I       2 ASCII CHARS OF NAME 
      ISZ CKLOP 
      RSS 
      JMP SEG1      LAST CHAR. CHECK
      CPA TSTNM,I   MATCH ? 
      RSS 
      JMP CONT      NO, CONTINUE
      INB           A(NEXT 2 CHARS) 
      ISZ TSTNM         DITTO 
      JMP SEG0
* 
SEG1  XOR TSTNM,I   TEST FOR LAST CHAR. 
      AND UBYTE      MATCH
      SZA,RSS 
      JMP MATCH 
* 
CONT  LDB D8        CALCULATE ADDRESS NEXT
      ADB IDADR      SHORT ID 
      ISZ NMSEG 
      JMP CHKLP 
* 
      JMP ERR14     SHORT ID NOT FOUND
      SKP 
* 
*     APPROPRIATE SHORT ID FOUND, TRY TO ACCESS FILE
* 
MATCH LDA IDADR     FIND THE ADDRESS OF THE BLOCK # 
      ADA D6         FOR THIS FILE
      LDA A,I        & SAVE FOR LODIT 
      STA IREC
* 
*     FIND RESERVED BLOCK FOLLOWING SHORT IDS 
* 
      LDA TEMP      # SEGMENTS
      MPY D8        RESULT WILL FIT IN A REG. 
      ADA TEMP1     LOW MAIN
      STA TEMP1     1ST WORD OF RESERVED BLOCK
      LDB A 
      JSB SUM       CHECK CHECKSUM
      LDA TEMP1 
      INA 
      STA TEMP      A(SECURITY CODE)
      INA 
      STA TEMP2     A(CRN / NODE #) 
* 
      LDA $XQT      GET FILE NAME 
      ADA D12 
      LDB AFNAM 
      JSB .MVW      MOVE IT TO LOCAL BUFFER 
      DEF D3
      NOP 
      LDA FNAME+2   MERGE 5TH & 6TH CHARS.
      AND UBYTE 
      ADA TEMP1,I   PICK UP 6TH CHAR FROM RESERVED BLK
      STA FNAME+2   SAVE BOTH BACK TO COMPLETE NAME 
* 
      CLA,INA       TURN ON REMOTE SESSION
      STA D$OVR      OVERRIDE.
      JSB DOPEN     OPEN REMOTE FILE CONTAINING THE 
      DEF *+7        SEGMENT
      DEF DCB       PSEUDO DCB
      DEF ERRS
      DEF FNAME 
      DEF D4        FORCE TO TYPE 1 
      DEF TEMP,I    SECURITY CODE 
      DEF TEMP2,I   CRN / NODE #
* 
      LDA ERRS      ANY ERROR ? 
      SSA 
      JMP ERRXX     RFA / DS ERROR
      SKP 
* 
*     SETUP FOR, & READ IN SEGMENT MAIN 
*     SET NEW 'CURRENT SEGMENT + 1' INTO ID SEGMENT 
* 
      LDB $XQT      FIND SEGMENT LOW MAIN 
      ADB D21        (EQUALS HIGH MAIN + 1) 
      LDA B         SAVE ADDRESS
      LDB B,I       GOT SEGMENT LOW MAIN
      INA           ADDRESS OF CURRENT SEG + 1 ADDR.
      STA TEMP1     SAVE IT 
      LDA IDADR     FIND SEG HIGH MAIN + 1
      ADA D4
      LDA A,I       GOT IT !
* 
      JSB $LIBR     GO PRIVILEGED TO WRITE
      NOP            NEW CURRENT SEG + 1 IN ID
      STA TEMP1,I 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
* 
      JSB LODIT     READ IN THE MAIN (IREC PRESET)
* 
*     DO BASE PAGE
* 
      CLA           CONTINUE READING FROM FILE
      STA IREC       WHERE WE LEFT OFF. 
      LDA IDADR     GET SEG HIGH BASE PAGE + 1
      ADA D5
      LDA A,I 
      LDB $XQT      GET LOW SEG BASE BAGE 
      ADB D24        (EQUALS HIGH MAIN B.P.+1)
      LDB B,I       GOT IT !
      JSB LODIT     LOAD B.P. 
      SKP 
      JSB DCLOS     CLOSE THE REMOTE FILE 
      DEF *+3 
      DEF DCB 
      DEF ERRS
      CLA           TURN OFF REMOTE SESSION 
      STA D$OVR      OVERRIDE.
* 
*     IF ANY PARAMETERS PASSED, PLACE THEM IN ID SEG. 
* 
      LDA XT1       FETCH 1ST PRAM ADDRESS
      CPA DZERO     ANYTHING PASSED ? 
      JMP SEG2      NOPE, DONE
      LDB $XQT
      INB 
      STB XB        SAVE FOR SEGMENT
      LDA XDEF      A(PRAM DEFS)
      JSB $LIBR     GO PRIVILEGED 
      NOP            TO GET TO ID SEGMENT 
      JSB .MVW      TRANSFER PRAMS
      DEF D5
      NOP 
      JSB $LIBX 
      DEF *+1 
      DEF *+1       CONTINUE
* 
*     SUCCESSFUL SEGLD SO LETS TRANSFER TO IT 
* 
SEG2  LDB XB        SET UP B REG.: IF NO PRAMS B IS 
*                                    ORIG. VALUE, ELSE A(ID TEMPS)
      LDA IDADR     SHORT ID ADDRESS
      ADA D3
      LDA A,I       SEGMENT ENTRY POINT ADDRESS 
      JMP A,I 
      SKP 
* 
*     ERROR & SEGRT EXITS 
* 
ERR07 LDA D7        CHECKSUM ERROR = 7
      RSS 
ERR14 LDA D14       SEGMENT ERROR = 14
ERRXX EQU *         RFA OR DS ERROR 
      STA IERR,I
* 
      JSB DCLOS     CLOSE FILE IF OPENED
      DEF *+3 
      DEF DCB 
      DEF ERRS
* 
      CLA 
      STA D$OVR     TURN OFF REMOTE SESS. OVERIDE 
RTRN  JMP DEGLD,I   RETURN TO CALLER
* 
*     RETURN TO MAIN FROM A SEGMENT 
* 
SEGRT NOP 
      CLA           NO ERROR
      STA IERR,I
      JMP RTRN      GO TO EXIT
      SKP 
* 
*     SUM - DOES A 7 WORD CHECKSUM & COMPARES RESULT WITH ONE'S 
*     COMPLEMENT OF 8TH WORD (AS REQ'D BY DS). ENTERED WITH B 
*     CONTAINING STARTING ADDRESS.  CONTENTS OF BOTH REGISTERS
*     DESTROYED. IF CHECK FAILS CONTROL NOT RETURNED TO CALLER. 
* 
SUM   NOP 
      LDA DM7       # WORDS TO SUM
      STA SUMCT     # WORDS TO SUM
      CLA           INITIALIZE ACCUMULATOR
SUMLP ADA B,I       ADD NEXT WORD 
      INB           NEXT WORD TO SUM
      ISZ SUMCT     DONE ?
      JMP SUMLP     NO
* 
      CMA           TAKE COMPLEMENT 
      CPA B,I        & COMPARE TO CHECKSUM WORD 
      JMP SUM,I     OK !
* 
      JMP ERR07     NO GOOD, SHORT ID CLOBBERED ! 
      SKP 
* 
*     LODIT - LOAD MEMORY FROM A REMOTE FILE
* 
*     LODIT LOADS PROGRAM OR BASE PAGE FROM A REMOTE FILE AS
*     FOLLOWS:  IT TAKES THE HIGH & LOW LOAD ADDRESSES FROM 
*     THE A & B REGISTERS, THE STARTING LOAD FILE RECORD #
*     FROM IREC AND TRANSFERS THE DATA BLOCK BY BLOCK UNTIL 
*     COMPLETE. THE FILE MUST BE AN ALREADY OPENED TYPE 6 
*     FILE (FORCED TO TYPE 1) AND NO CHECKING IS DONE AS TO 
*     WHETHER THE HIGH & LOW LOAD ADDRESSES ARE CORRECT.
* 
*     CALLING SEQUENCE: 
*                        A = HIGH ADDRESS + 1 
*                        B = LOW ADDRESS
*                     IREC = LOAD FILE RECORD # 
* 
*                     JSB LODIT 
*     ON RETURN:
*                     CONTENTS OF BOTH REGS. DESTROYED
* 
LODIT NOP 
      STA HIHAD     SAVE HIGH ADDRESS 
      LDA D128      INITIALIZE TRANSFER SIZE
      STA SVAMT 
* 
*     READ / LOAD LOOP
* 
LODLP STB LOWAD     SAVE LOW ADDRESS
      CMB,INB 
      ADB HIHAD     HIGH - LOW
      SZB,RSS       ANYTHING LEFT ? 
      JMP LODIT,I   NOPE, DONE !
      SSB 
      JMP LODIT,I   DONE !
      LDA D128      LESS THAN 128 WORDS LEFT ?
      CMA,INA 
      ADA B 
      SSA 
      STB SVAMT     YES, ONLY TRANSFER REMAINDER
* 
      JSB DREAD     READ IN A BLOCK 
      DEF *+7        (OR PARTIAL BLOCK) 
      DEF DCB 
      DEF ERRS
      DEF IDBUF     INPUT BUFFER
      DEF SVAMT     # WORDS (</=128)
      DEF LEN       # WORDS READ
      DEF IREC      1ST RECORD REQ'D OR 0 
* 
      LDA ERRS
      SSA 
      JMP ERRXX     RFA OR DS ERROR 
      SKP 
* 
*     MOVE PROGRAM TO FINAL DESTINATION 
* 
      LDA AIDBF     SOURCE
      LDB LOWAD     DESTINATION 
      JSB $LIBR     GO PRIVELEGED 
      NOP 
      JSB .MVW
      DEF SVAMT     # WORDS 
      NOP 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
* 
      CLA           PREPARE TO READ NEXT
      STA IREC       SEQUENTIAL RECORD
      LDB LOWAD     CALCULATE NEW LOAD ADDRESS
      ADB SVAMT 
      JMP LODLP     CONTINUE
      SKP 
* 
*     CONSTANTS 
* 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D8    DEC 8 
D12   DEC 12
D14   DEC 14
D20   DEC 20
D21   DEC 21
D23   DEC 23
D24   DEC 24
D128  DEC 128 
DM3   DEC -3
DM5   DEC -5
DM7   DEC -7
B176K OCT 176000
UBYTE OCT 177400
ZERO  OCT 0 
* 
*     VARIABLES 
* 
XB    NOP           B REGISTER STORAGE
NMSEG NOP           # OF PROGRAM SEGMENTS 
CKLOP NOP           NAME CHECK LOOP COUNT 
IDADR NOP           ADDRESS OF CURRENT SHORT ID 
IREC  NOP           DREAD RECORD #
ERRS  NOP           RFA ERRORS
SUMCT NOP           SUMMING LOOP COUNTER
SVAMT NOP           # WORDS TO TRANSFER 
TSTNM NOP           A(SEG. NAME) FOR COMPARE
LEN   NOP           # WORDS ACTUALLY READ 
LOWAD NOP           LOW LOAD ADDRESS
HIHAD NOP           HIGH LOAD ADDRESS + 1 
FNAME BSS 3         REMOTE FILE NAME
DCB   BSS 4         PSEUDO DCB FOR RFA
TEMP  NOP 
TEMP1 NOP 
TEMP2 NOP 
* 
IDBUF BSS 128       DREAD INPUT BUFFER
* 
XDEF  DEF XT1 
DZERO DEF ZERO
AFNAM DEF FNAME 
AIDBF DEF IDBUF 
* 
A     EQU 0 
B     EQU 1 
END   EQU * 
      END 
                                                    