ASMB,R,L,C
*     NAME:   SEGLD 
*     SOURCE: 92064-18175 
*     RELOC:  92064-16058 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
* 
      NAM SEGLD,7  92064-16058  REV.1726  770510
* 
* 
* 
* 
* 
* 
      ENT SEGLD 
* 
      EXT .ENTR,PMOVE 
      EXT .MVW,OPEN,READF,CLOSE 
      SUP 
* 
* 
SEGLD NOP 
      STB XB        SAVE B REGISTER IN CASE NO PARMS PASSED 
      LDA WD5A      RESET TRAILER RRECORDS
      STA SPCAD       POINTER.
* 
      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 
      DEF NAMR       CALL PARMS 
* 
      LDA NAMR      MUST HAVE 
      CPA DZERO         NAME PARM.
      JMP PERR            ELSE--EXIT -10
* 
* 
*   IF NO TEMPS -- MOVE ID TMPS TO LOCAL BUFFER 
*       ELSE MOVE TEMPS INTO LOCAL BUFFER 
* 
* 
* 
      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 OPEN
      DEF RTO 
      DEF SGDCB     <NOT EXT> 
      DEF ERRS
      DEF NAMR,I
      DEF OPENO     FORCE TO BINARY 
* 
RTO   LDA ERRS      FETCH ERROR RETURN
      SSA 
      JMP SGERR     OPEN ERROR
* 
      SPC 5 
* 
*     READ ABSOLUTE RECORD
* 
RDF0  JSB READF     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 CLOSE     GO CLOSE IF OPEN
      DEF CEX 
      DEF SGDCB 
* 
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
      JMP RDF0      FETCH NEXT RECORD 
      SPC 3 
* 
*   GOT A EOF 
* 
EOF   LDA N39       RELOCATABLE INPUT ERROR 
      LDB SPCAD 
      CPB WD5A
      JMP SGERR     MUST HAVE SEEN 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 CLOSE 
      DEF CRTN
      DEF SGDCB     CLOSE SEG FILE BEFORE ENTERING THE UNKNOWN! 
* 
* 
* 
*  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 
* 
* 
* 
      SKP 
* 
.2    DEC 2 
.4    DEC 4 
.22   DEC 22
.64   DEC 64
N5    DEC -5
N10   DEC -10 
N39   DEC -39 
IBUF  BSS 64
* 
ZERO  NOP 
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 
* 
* 
****Z OPTION FOR CARTRIDGE
* 
****N OPTION FOR DISKETTE 
* 
* 
SGDCB BSS 144 
* 
* 
XEQT  EQU 1717B 
A     EQU 0 
B     EQU 1 
PLEN  EQU * 
      END 
                                                                                                                                                                        