ASMB,R,L,C,Z
*     NAME:   SEGLD 
*     SOURCE: 92064-18175 
*     RELOC:  92064-16058  'N' ASSEMBLY OPTION:  STANDARD RTE 
*     RELOC:  91740-16069  'Z' ASSEMBLY OPTION:  DS/1000
*     PGMR:   G.L.M.,C.E.J. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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.       *
*  ***************************************************************
* 
* 
      IFN 
      NAM SEGLD,7 92064-16058 REV 1740 770912 
      XIF 
      IFZ 
      NAM SEGLD,7 91740-16069 REV 1740 770912 
      XIF 
* 
* 
      ENT SEGLD 
* 
      EXT .ENTR,.MVW,$LIBR,$LIBX
      IFZ 
      EXT DOPEN,DREAD,DCLOS 
      XIF 
      IFN 
      EXT OPEN,READF,CLOSE
DOPEN EQU OPEN
DREAD EQU READF 
DCLOS EQU CLOSE 
      XIF 
      SUP 
* 
* 
SEGLD NOP 
      STB XB        SAVE B REGISTER IN CASE NO PARMS PASSED 
      LDA WD5A      RESET TRAILER RECORDS 
      STA SPCAD       POINTER.
* 
      LDA DZERO 
      STA NAMR      RESET PARMS 
      STA IERR
      STA XT1 
      STA XT2 
      STA XT3 
      STA XT4 
      STA XT5 
      IFZ 
      STA NODE
      XIF 
      CLA 
      STA SPCNT     ZERO SPECIAL RECORD COUNT 
      IFZ 
      CMA 
      STA DNODE     RESET LOCAL DEFAULT FOR DS NODE 
      XIF 
      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
      IFZ 
NODE  DEF ZERO
      XIF 
* 
DEGLD NOP      DUMMY ENTRY POINT
ENTD  JSB .ENTR     FETCH 
      DEF NAMR       CALL PARMS 
* 
      LDA NAMR      MUST HAVE 
      CPA DZERO         NAME PARM.
      JMP PERR            ELSE--EXIT -10
      IFZ 
* 
*  SET  UP DESTINATION NODE PARAMETER FOR DS CALLS
* 
      LDA NODE      DESTINATION NODE
      CPA DZERO       GIVEN?
      JMP L.0         NO--DEFAULT IS LOCAL NODE 
      LDA A,I         YES--FETCH PARAMETER
      STA DNODE         AND SAVE IT IN TWO WORD CRN 
      XIF 
* 
* 
*   IF NO TEMPS -- MOVE ID TMPS TO LOCAL BUFFER 
*       ELSE MOVE TEMPS INTO LOCAL BUFFER 
* 
* 
* 
L.0   LDA XT1       FETCH 1ST PARAMETER ADDRESS 
      CPA DZERO     ANYTHING PASSED?
      JMP NOPAR     NOPE--NOTHING PASSED
* 
      LDA N5        SETUP TO
      STA LMAIN     MOVE 5 PARMS INTO 
      LDA XDEF      LOCAL BUFFER
      STA HMAIN 
* 
L.1   LDA HMAIN,I   FETCH PARAMETER ADDRESS 
      LDA A,I       FETCH PARAMETER 
      STA HMAIN,I   SAVE IT LOCALLY 
* 
* 
      ISZ HMAIN     BUMP PARAMETER ADDRESS POINTER
      ISZ LMAIN     ALL FIVE DONE?
      JMP L.1       NOPE CONTINUE 
* 
      LDA XEQT      FETCH ID ADDRESS
      INA           ADVANCE TO TEMP ADDRESS 
      STA XB        SET AS B FOR SEGMENT ENTRY
* 
* 
* 
* 
* 
*     FETCH PROGRAM LIMITS
* 
PLIM  LDA XEQT      FETCH 
      ADA .22         HIGH-LOW
      LDB DHILO         VALUES FOR
      JSB .MVW              MAIN AND
      DEF .4                    BASE PAGE 
* 
      NOP 
* 
      STA W27       SAVE FOR HIGH SEG ADDR
* 
*     OPEN FILE CONTAINING
*       REQUESTED SEGMENT 
* 
      JSB DOPEN 
      DEF RTO 
      DEF SGDCB     <NOT EXT> 
      DEF ERRS
      DEF NAMR,I
      DEF OPENO     FORCE TO BINARY 
      IFZ 
      DEF ZERO      <PLACE HOLDER>
      DEF CRN       2ND WORD IS DESTINATION NODE
      XIF 
* 
RTO   LDA ERRS      FETCH ERROR RETURN
      SSA 
      JMP SGERR     OPEN ERROR
* 
      SPC 5 
* 
*     READ ABSOLUTE RECORD
* 
RDF0  JSB DREAD     READ
      DEF RTR 
      DEF SGDCB         THRU SEGLD'S DCB
      DEF ERRS
      DEF IBUF          INTO IBUF 
      DEF .64             MAX RECORD LEGNTH 
      DEF LEN               ACTUAL READ LEGNTH RETURNED HERE
* 
RTR   SSA           ERROR CODE RETURNED IN (A)
      JMP SGERR     GOT AN ERROR --EXIT 
* 
*     CHECK FOR EOF 
* 
      LDA LEN       FETCH LEGNTH WORD 
      SSA           SEE IF NEG (EOF?) 
      JMP EOF       GOT EOF-GO DO EOF THING 
* 
*     DO CHECKSUM 
* 
      LDA IBUF      FETCH 1ST WORD
      AND LHALF     ISOLATE ABS SIZE
      ALF,ALF       GET TO  LOW END 
      STA ABSSZ     SAVE ABS SIZE 
* 
* 
*   CALCULATE AND SAVE RECORD HIGH ADDRESS
* 
* 
      CCB           REC SIZE
      ADB A               MINUS 1 
      ADB WD2                  PLUS LOAD ADDRESS
      STB RECSZ                     EQUALS HIGH ADDRESS.
* 
* 
      CMA,INA       NEGATE
      STA MTMP1      SAVE FOR CHECKSUM
      LDB WD2       FETCH WD2 AND ADDR
      LDA WD3A      OF WORD 3 
      STA TMP2
* 
CKSM1 LDA TMP2,I      FETCH NEXT WORD 
      ADB A         ADD TO CHECKSUM 
      ISZ TMP2       BUMP WORD POINTER
      ISZ MTMP1     BUMP COUNT--DONE? 
      JMP CKSM1     NO--CONTINUE
* 
* 
      LDA TMP2,I    FETCH CHECKSUM WORD 
      CPA B         COMPARE TO CALCULATED VALUE 
      JMP CKOK      IT'S OK 
* 
      SPC 3 
* 
      LDA N28       CKSUM ERROR CODE
      RSS 
BNDER LDA N27       BOUNDS ERROR
      RSS 
PERR  LDA N10       PARAMETER ERROR 
SGERR STA IERR,I    SET ERROR CODE
* 
      JSB DCLOS     GO CLOSE IF OPEN
      DEF CEX 
      DEF SGDCB 
      DEF ERRS
* 
CEX   LDA IERR,I    SET A= ERROR CODE FOR RETURN
      JMP DEGLD,I   EXIT
      SPC 2 
N27   DEC -27 
N28   DEC -28 
* 
*     SEE WHERE RECORD GOES 
* 
CKOK  LDA WD2       FETCH ADDR OF RECORD
      CPA .2
      JMP SPC       MIGHT BE SPEC REC 
* 
BPLNK AND BPMSK     CHECK FOR BASE PAGE 
      CPA WD2 
      JMP BPR       YEP- IT'S A BASE PAGE RECORD
* 
      DLD LMAIN      --MAIN MEMORY RECORD-FETCH 
      JMP CKB           BOUNDS
* 
BPR   DLD LBASE FETCH BP BOUNDS 
* 
CKB   JSB CKBND     GO SEE IF RECORD IS WITHIN BOUNDS 
      JMP BNDER     BOUNDS ERROR
* * 
* 
*   COPY ABS TO MEMORY
* 
* 
      LDA WD3A      FETCH ADDR OF WD3(FW OF CODE) 
      LDB WD2       ACTUAL LOAD ADDR
      JSB PMOVE     GO PRIV AND MOVE CODE IN
ABSSZ NOP 
      JMP RDF0      GO GET NEXT RECORD
* 
* 
      SPC 3 
* 
*  MOVE THE ID TEMPS INTO LOCAL BUFFER
* 
* 
NOPAR LDA XEQT       ID SEG ADDRESS 
      INA            ADVANCE TO TEMP AREA 
      LDB XDEF       LOCAL BUFFER ADDRESS 
      JSB .MVW       MOVE THEM IN 
      DEF .5         ALL FIVE OF THEM 
      NOP 
      JMP PLIM       CONTINE WITH PROGRAM LIMITS
* 
* 
SPC   CPA ABSSZ     IF LEN=2
      RSS           THEN ITS A SPECIAL
      JMP BPR       ---NO, MUST BE A LINK 
* 
      DLD WD3       FETCH TRAILER RECORDS 
      DST SPCAD,I   SAVE IN INPUT BUFFER
      ISZ SPCAD 
      ISZ SPCAD     BUMP POINTER FOR NEXT SPEC REC
      ISZ SPCNT       AND SPECIAL RECORD COUNT
      JMP RDF0      FETCH NEXT RECORD 
      SPC 3 
* 
*   GOT AN EOF
* 
EOF   LDA N39       RELOCATABLE INPUT ERROR 
      LDB SPCNT 
      CPB .10 
      RSS 
      JMP SGERR     MUST HAVE SEEN 10 SPECIAL RECORDS 
* 
* 
* 
      LDA ID27      LOCATION OF SEG HIGH ADDR(SPC REC)
      LDB W27       ID SEGMENT WD 27 ADDRESS
      JSB PMOVE     GO SETIT
.1    OCT 1 
* 
      JSB DCLOS 
      DEF CRTN
      DEF SGDCB     CLOSE SEG FILE BEFORE ENTERING THE UNKNOWN! 
      DEF ERRS
* 
* 
* 
*  MOVE THE PARAMETERS INTO THE ID SEGMENT
* 
*  THE PARAMETERS ARE: 1) FIVE TEMPS PASSED IN CALL  (B=ID TEMP AREA) 
*                   OR 2) FIVE TEMPS FROM ID IF NOTHING PASSED
*                         B IS NOT CHANGED. 
* 
* 
* 
CRTN  LDA XDEF      ADDRESS OF PARAMETERS 
      LDB XEQT      IDSEG ADDRESS 
      INB           ADVANCE TO TEMP AREA
* 
*  GO PRIV AND MOVE THEM IN 
* 
      JSB PMOVE 
.5    OCT 5 
* 
* 
      LDB XB        IF NO PARMS B=ORIG VALUE
*                         ELSE  B=ID TEMP ADDRESS 
* 
      LDA XEQT      SET A=ID SEG ADDRESS
      JMP WD4,I     ENTER SEGMENT 
      SPC 3 
* 
* 
CKBND NOP 
      CMA,INA 
      ADA WD2 
      SSA 
      JMP CKBND,I 
* 
      CMB,INB 
      ADB RECSZ 
      SSB 
      ISZ CKBND 
      JMP CKBND,I 
* 
* 
*  ROUTINE TO MOVE WORDS IN PRIVELEDGED MODE
* 
PMOVE NOP 
      JSB $LIBR 
       NOP
      JSB .MVW
       DEF PMOVE,I
      NOP 
      ISZ PMOVE 
      JSB $LIBX 
       DEF PMOVE
* 
* 
* 
      SKP 
* 
.2    DEC 2 
.4    DEC 4 
.10   DEC 10
.22   DEC 22
.64   DEC 64
N5    DEC -5
N10   DEC -10 
N39   DEC -39 
IBUF  BSS 64
* 
ZERO  NOP 
      IFZ 
DNODE DEC -1
CRN   EQU ZERO
      XIF 
DZERO DEF ZERO
XDEF  DEF XT1 
XB    NOP 
* 
DHILO DEF LMAIN 
LMAIN NOP 
HMAIN NOP 
LBASE NOP 
HBASE NOP            DON'T CHANGE ABOVE ORDER 
* 
SPCAD NOP 
MTMP1 EQU SEGLD 
W27   NOP 
ERRS  NOP 
OPENO OCT 110       FORCE TO BINARY 
LEN   NOP 
LHALF OCT 177400
WD2   EQU IBUF+1
WD3   EQU IBUF+2
WD4   EQU IBUF+3
WD3A  DEF IBUF+2
WD5A  DEF IBUF+4
TMP2  NOP 
BPMSK OCT 1777
ID27  DEF IBUF+17    NEED ADDRESS TO SET SEG HIGH 
RECSZ NOP 
SPCNT NOP 
* 
      IFN 
SGDCB BSS 144 
      XIF 
      IFZ 
SGDCB BSS 4 
      XIF 
* 
* 
XEQT  EQU 1717B 
A     EQU 0 
B     EQU 1 
PLEN  EQU * 
      END