ASMB,Q,C
HED IDADL: 91750-1X127 REV 2013 (C) HEWLETT-PACKARD CO. 1980
NAM IDADL,8 91750-1X127 REV 2013 791119 L
*
SPC 2
******************************************************************
* * (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 THE HEWLETT-PACKARD COMPANY. *
******************************************************************
SPC 4
****************************************************************
*
* NAME: IDADL
* SOURCE: 91750-18127
* RELOC: 91750-1X127
* PGMR: DAN GIBBONS
*
***************************************************************
SPC 2
ENT #IDAD
EXT $IDSZ,$IDA
*
* THIS SUBROUTINE ACCEPTS AN RTE-L FILE DIRECTORY OPEN-
* FLAG (CONTAINING EXCLUSIVE OPEN FLAG IN BIT 15 AND IDSEG
* # IN RIGHT BYTE) IN THE A-REG, AND CONVERTS IT TO THE
* FORMAT USED BY M & PRE-RTE4B SYSTEMS (BIT 15 UNCHANGED,
* BITS 0-14 = IDSEG ADDRESS).
*
*
* CALLING SEQUENCE:
*
* = L-TYPE OPEN FLAG
* JSB #IDAD
* RETURN--=M/RTE4B-TYPE OPEN FLAG, DESTROYED
*
SKP
#IDAD NOP =L-TYPE OPEN FLAG
STA TEMP SAVE IT
AND RTBYT ISOLATE IDSEG #
SZA,RSS ANY IDSEG #?
JMP #IDAD,I NO, RETURN WITH =0
ADA M1
MPY $IDSZ =(IDSEG#-1)(IDSEG SIZE)
ADA $IDA ADD STARTING ADR OF IDSEGS
LDB TEMP RETRIEVE ORIGINAL OPEN FLAG
ELB =EXCLUSIVE OPEN BIT
RAL,ERA SET IT INTO BIT 15
JMP #IDAD,I RETURN. =ALTERNATE TYPE OPEN FLAG
SPC 3
TEMP NOP
RTBYT OCT 377
M1 DEC -1
END