ASMB,R,Q,C
      HED #IDSG 91750-1X225 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM #IDSG,7 91750-1X225 REV.2013 800725 ALL 
* 
******************************************************************
*  * (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.       *
******************************************************************
* 
* 
      ENT #IDSG 
* 
      EXT .ENTR,PGMAD,$OPSY 
* 
* NAME:   #IDSG 
* SOURCE: 91750-18225 
* RELOC:  PART OF 91750-12014, -12015 
* PRGMR:  JIM HARTSELL
* 
* 
* PRECURSOR OF A
* GENERAL-PURPOSE SUBROUTINE TO RETURN AN ITEM FROM AN ID SEGMENT,
* DEPENDING ON OP SYSTEM UNDER WHICH THE ROUTINE IS RUNNING.
* 
* CALLING SEQUENCE:      JSB #IDSG
*                        DEF *+4 OR 5 
*                        DEF IDADR      ID SEG ADDR OR ZERO (SELF). 
*                        DEF ITEM       ITEM NUMBER.
*                        DEF VALUE      RETURNED VALUE, RIGHT JUSTIFIED.
*                       [DEF OPTYP]     RETURNED OP SYSTEM TYPE (OPT.). 
* 
B     EQU 1 
      SUP 
* 
IDADR NOP 
ITEM  NOP 
VALUE NOP 
OPTYP NOP 
* 
#IDSG NOP           ENTRY POINT.
* 
      JSB .ENTR     GET CALLER'S PARAMETER ADDRESSES. 
      DEF IDADR 
* 
      CLA           IN CASE PARAM NOT SPECIFIED.
      LDA IDADR,I   GET ADDRESS OF ID SEGMENT.
      STA XEQT      SAVE. 
      SZA 
      JMP IDSG1     IF SPECIFIED, GO GET ITEM.
* 
      STA BUFR      GET ID SEG ADDR OF CURRENT PROGRAM. 
* 
      JSB PGMAD     (NO "IDGET" IN RTE-M).
      DEF *+3 
      DEF BUFR
      DEF XEQT
* 
IDSG1 CLA           IN CASE PARAM NOT SPECIFIED.
      LDA ITEM,I    GET ITEM NUMBER.
      SZA,RSS 
      JMP IDEX      IGNORE CALL IF NOT SUPPLIED OR ZERO.
* 
      LDA $OPSY     GET OP SYSTEM TYPE. 
      LDB OPTYP     RETURN IT TO CALLER IF
      SZB             THE PARAM WAS SPECIFIED.
      STA OPTYP,I 
* 
* TEMPORARY QUICK & DIRTY FETCH OF PROGRAM SEQUENCE NUMBER. 
* (#IDSG CALLED BY #MSSM: ITEM NUMBER TENTATIVELY = 1)
* 
      LDB XEQT      PRIME WITH ADDR OF ID SEGMENT.
      CPA N5
      JMP RTEM3     RTE-MIII (NO SEQ #).
      CPA N31 
      JMP PSC2      RTE-L10.
      CPA N29 
      JMP PSC2      RTE-L20.
      CPA N9
      JMP PSC1      RTE-IVB.
      CPA N13 
      JMP PSC1      RTE-IVM.
      CPA N17 
      JMP PSC1      RTE-VI. 
      CPA N21 
      JMP PSC1      RTE-VIM.
RTEM3 CLA 
      JMP PSC3      NONE OF THE ABOVE.
PSC1  ADB B3        OFFSET WILL BE 31.
PSC2  ADB D28       OFFSET = 28.
      JSB LODWD     GET USER'S PROG SEQ COUNTER.
      ALF 
PSC3  AND B17 
IDEX  LDB VALUE     PASS ITEM VALUE TO CALLER,
      SZB             IF PARAMETER WAS SPECIFIED. 
      STA VALUE,I 
* 
      JMP #IDSG,I   RETURN TO CALLER. 
* 
LODWD NOP 
      LDA $OPSY 
      RAR,SLA       SKIP IF NON-DMS.
      JMP *+3 
      LDA B,I       NON-DMS.
      JMP LODWD,I 
      XLA B,I       DMS.
      JMP LODWD,I 
* 
* 
B3    OCT 3 
B17   OCT 17
D28   DEC 28
N5    DEC -5
N9    DEC -9
N13   DEC -13 
N17   DEC -17 
N21   DEC -21 
N29   DEC -29 
N31   DEC -31 
XEQT  NOP 
BUFR  BSS 3 
* 
      END 
                                                                                                                                                                                                                                      