ASMB,R,Q,C
* 
*     NAME:   LA..
*     SOURCE: 92071-18102 
*     RELOC:  92071-1X102 
*     PGMR:   C.H.W.,DJN
* 
*  **************************************************************** 
*  * (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 LA..,7  92071-1X102  REV.2041  800807 
* 
* 
* 
*  ACTION SUBROUTINE TO EXECUTE THE "LA" OPERATOR COMMAND 
* 
*    COMMAND SYNTAX:
*        LA,LU(,DVT(,S.C.)) 
* 
* 
      ENT LA..
* 
      EXT $LIBR,$LIBX,$SCHD,CAM.O,CNOPT 
      EXT $LUTA,$LUT#,$DVTA,$DVT# 
      EXT $DIOC,$UINI,$DVLU,$DV2,$DV6,$DV8
      EXT .XLA,.XSA,.XLB,$SJS0,$SJS1
* 
*  THE FOLLOWING REFERENCES ARE NEEDED ONLY OF DVT,IFT SWITCHES 
* 
*     EXT .XSB,$IFT#,$IFTA
* 
* 
* 
LA..  NOP 
      LDA LA..
      INA 
      LDB 0,I 
      STB NUMBA     SAVE ADDR OF # PRAMS
      INA           2ND PARAMETER IS THE PARSE BUFFER ADDR
      LDB 0,I       GET IT
      INA 
      LDA 0,I 
      STA ERRTN     SAVE ADDR OF ERROR PARAM
      LDA LA..,I
      STA LA..      SAVE RETURN ADDR
* 
*  PROCESS LU PARAMETER 
      INB           1ST PARAM IS LU 
      LDA 1,I       GET IT
      STA M.LU
      CMA,INA       A=-LU 
      SSA,RSS       WAS LU < 1? 
      JMP ER56       YES, ERROR 
      STA TEMP      SAVE FOR ADD
      JSB .XLA      GET # OF LUS
      DEF $LUT# 
      ADA TEMP
      SSA           OK? 
      JMP ER56       NO, LU OUT OF RANGE
      JSB .XLA      GET ADDRESS OF LUT
      DEF $LUTA 
      ADA M.LU      POINT TO ENTRY FOR LU 
      ADA N1
      STA LUTAD     SAVE ADDR OF LU ENTRY 
      LDA NUMBA,I   GET # OF PARAMS ENTERED 
      CPA .1        DISPLAY LU? 
      JMP LD.00      YES
      JSB .XLA      GET LUT CONTENTS
      DEF LUTAD,I 
      SZA           BIT BUCKET? 
      JSB CKDSK      NO, ENSURE IT'S NOT A DISC 
* 
*  PROCESS DVT PARAMETER
      ADB .4        ADDR OF DVT # 
      LDA 1,I       GET IT
      SSA 
      JMP ER56      ERROR IF DVT # NEGATIVE 
      CMA,INA,SZA,RSS NEGATE DVT #
      JMP LA.45     ASSIGN LU TO BIT BUCKET 
      STA TEMP      USE TO COUNT DVT'S
      JSB .XLA      ADD # OF DVT'S IN SYSTEM
      DEF $DVT# 
      ADA TEMP
      SSA 
      JMP ER56      ERROR, DVT # TOO LARGE
      ADB .4        ADDR OF PRAM 3
      STB M.SC
      JSB .XLB      ADDR OF 1ST DVT 
      DEF $DVTA 
      RSS 
* 
LA.05 JSB NXDVT     GET ADDR OF NEXT DVT
      ISZ TEMP      IS THIS THE ONE?
      JMP LA.05      NO, ITERATE
* 
      STB DVTAD     SAVE DVT'S ADDRESS
      LDA 1 
      JSB CKDSK     ENSURE NOT SWITCH TO A DISK 
      LDA NUMBA,I   GET # OF PARAMS 
      CPA .2        JUST LU SWITCH? 
      JMP LA.50      YES
      JMP ER56       TOO MANY PARAMATERS
* 
*  DVT TO IFT SWITCHING WAS REMOVED AS AN RTE-XL CAPABILITY 
*  DUE TO QUICK AND EASY GENERATIONS (WITH NO RELOADING)
*  ITS ASSOCIATED CODE REMAINS IN THE SOURCE AS A COMMENT 
*  IN CASE SOMEONE FEELS THEY REALLY NEED THIS CAPABILITY.
**
*      HED      ******* DVT SWITCHING TO NEW IFT *******
*      ADB .4        ADDR OF DVT5 
*      STB DVT5      SAVE IT
*      CPA =D3       DVT SWITCH?
*      INB,RSS        YES 
*      JMP ER56       NO, CALLING ERROR 
*      JSB $LIBR     GO PRIVILEGED
*      NOP
*      JSB .XLA      GET DVT6 "AV"
*      DEF 1,I
*      SSA           IS DEVICE BUSY?
*      JMP ER37       YES, CAN'T SWITCH NOW 
**
**  PROCESS SELECT CODE PARAMETER 
*      JSB .XLA      NUMBER OF IFT'S IN SYSTEM
*      DEF $IFT#
*      CMA,INA       NEGATE 
*      STA TEMP      SAVE COUNTER 
*      JSB .XLB      ADDR OF 1ST IFT
*      DEF $IFTA
**  FIND IFT WITH SPECIFIED SELECT CODE 
*LA.10 STB IFTAD     SAVE ADDR OF IFT 
*      ADB .5        ADDR OF THIS IFT'S WORD 6
*      JSB .XLA      GET IFT6 
*      DEF 1,I
*      AND B77       ISOLATE SELECT CODE
*      CPA M.SC,I    DOES IT MATCH PARAM #4?
*      JMP LA.15     YES
**  FIGURE OUT STARTING ADDR OF NEXT IFT
*      INB
*      JSB .XLA      GET IFT7 
*      DEF 1,I
*      AND =B777     ISOLATE EXT LENGTH 
*      INA
*      ADB 0         B NOW HAS NEXT IFT'S ADDR
*      ISZ TEMP      HAVE ALL IFT'S BEEN EXAMINED?
*      JMP LA.10      NO, ITERATE 
*      LDA .56        YES, SELECT CODE IN ERROR 
*      JMP ERPRV
**  IFT FOUND,  ENSURE IT'S SAME INTERFACE TYPE ELSE ERROR 35 
*LA.15 JSB .XLA      GET "ITYPE"
*      DEF 1,I
*      JSB .XLB      GET ORIGINAL IFT ADDR
*      DEF DVT5,I 
*      ELB,CLE,ERB   CLEAR SIGN 
*      ADB .5        POINT TO ITS "ITYPE" 
*      STA TEMP 
*      JSB .XLA      COMPARE THE TWO
*      DEF 1,I
*      XOR TEMP 
*      AND =B37400   ISOLATE BITS 13-8
*      SZA           DOES ITYPE MATCH?
*      JMP ER35       NO, GIVE ERROR
**
**  UNLINK DVT FROM IT'S OLD CIRCULAR DVT LIST
*      CCB
*      ADB DVT5      POINT TO DVT4
*      STB TEMP 
*LA.20 JSB .XLA      GET NEXT DVT ADDR IN LIST
*      DEF 1,I
*      RAL,CLE,ERA   CLEAR SIGN 
*      CPA DVTAD     IS IT THE REMOVED DVT? 
*      JMP LA.25      YES 
*      ADA =D3
*      LDB 0
*      JMP LA.20     LOOP 
*LA.25 JSB .XLA      GET LINK FROM REMOVED DVT
*      DEF TEMP,I 
*      RAL,ERA       RESTORE SIGN BIT 
*      JSB .XSA      SET UPDATED LINK WORD IN PREV. DVT 
*      DEF 1,I
**
**  UPDATE IFT'S DVT REFERENCE IF IT POINTS TO REMOVED DVT
**
*      JSB .XLB      GET IFT ADDRESS
*      DEF DVT5,I 
*      ELB,CLE,ERB   CLEAR SIGN 
*      ADB .4        POINT TO IFT5
*      JSB .XLA      GET DVT REFERENCE IN IFT 
*      DEF 1,I
*      CPA DVTAD     IS IT THE REMOVED DVT? 
*      RSS            YES 
*      JMP LA.30      NO, IGNORE
*      JSB .XLA      ADDR OF NEXT DVT IN OLD DVT LIST 
*      DEF TEMP,I 
*      ELA,CLE,ERA   STRIP SIGN 
*      CPA DVTAD     THIS DVT ONLY ONE ON LIST? 
*      CLA            YES, THEN ZERO THE DVT REFERENCE
*      JSB .XSA      STORE NEW DVT REFERENCE IN IFT5
*      DEF 1,I
*      SKP
**
**  NOW QUEUE THE DVT ON ITS NEW INTERFACE'S DVT LIST 
**
*LA.30 JSB .XLA      GET IFT REFERENCE
*      DEF DVT5,I 
*      ELA           SAVE "P"-BIT 
*      LDA IFTAD
*      RAL,ERA       MOVE "P" INTO NEW IFT ADDR WD
*      JSB .XSA      UPDATE THE IFT REFERENCE 
*      DEF DVT5,I 
*      LDB IFTAD     NEW IFT'S ADDR 
*      ADB .4        IFT5 ADDR
*      JSB .XLA      GET IFT'S DVT REF
*      DEF 1,I
*      SZA,RSS       ANY DVT REFERENCED?
*      JMP LA.40      NO
*      ADA =D3       POINT TO IT'S CIRCULAR LIST
*      JSB .XLB      GET IT 
*      DEF 0,I
*      RBL,CLE,ERB   SAVE/CLEAR SIGN
*      STB TEMP      SAVE ADDR OF NEXT DVT
*      LDB DVTAD
*      RBL,ERB       RESTORE SIGN 
*      JSB .XSB       & LET DVT REFERENCE THE NEW ONE 
*      DEF 0,I
*LA.35 CCB
*      ADB DVT5      DVT4 OF REQUEUED DVT 
*      JSB .XLA 
*      DEF 1,I
*      ELA           SAVE SIGN OF REQUEUED DVT4 
*      LDA TEMP      REFERENCE TO NEXT DVT ON NEW LIST
*      RAL,ERA       RESTORE SIGN 
*      JSB .XSA       & UPDATE LINK IN REQUEUE'D DVT4 WORD
*      DEF 1,I
**  THE DVT IS NOW REQUEUED ON IT'S NEW IFT 
*      JMP LA.60
**
*LA.40 LDA DVTAD     THE REQUEUED DVT IS ONLY ONE ON
*      JSB .XSA       THE INTERFACE, SO IFT5 POINTS TO IT 
*      DEF 1,I
*      STA TEMP      SET POINTER TO LINK DVT4 TO SELF 
*      JMP LA.35
* 
      HED      ******* LU SWITCHING TO NEW DVT *******
*  HERE FOR ASSIGNMENT OF LU TO BIT BUCKET
LA.45 LDA NUMBA,I   GET # OF PARAMS 
      CPA .2        EXACTLY 2?
      CLA,RSS        YES, SWITCH TO BIT BUCKET OK 
      JMP ER56       NO, HE DOESN'T KNOW WHAT HE'S DOING
      STA DVTAD     PUT A ZERO IN LUT TABLE ENTRY 
      SPC 3 
* 
*  ENTER HERE FOR LU SWITCH 
* 
LA.50 JSB $LIBR     GO PRIVILEGED 
      NOP 
* 
LA.60 JSB .XLB      GET OLD ASSIGNMENT
      DEF LUTAD,I 
      LDA DVTAD 
      JSB .XSA      SET LU TABLE TO REFLECT NEW DVT 
      DEF LUTAD,I 
      SZB,RSS       BIT BUCKET? 
      JMP LA.90      YES, DONT WORRY ABOUT LOCK OR WAITERS
*  SEE IF OLD DVT WAS LOCKED
      STB TEMP      SAVE OLD DVT ADDRESS
      ADB .6        POINT TO DVT 7
      JSB .XLA
      DEF 1,I 
      AND LUMSK     ISOLATE LOCK FLAG 
      SZA,RSS       IS PREVIOUS DVT LOCKED? 
      JMP LA.75      NO 
*  CLEAR OLD DVT'S LOCK FLAG
      STA NUMBA     SAVE LOCK FLAG
      JSB .XLA      CLEAR FLAG BITS IN DVT7 
      DEF 1,I 
      XOR NUMBA 
      JSB .XSA       & UPDATE DVT 
      DEF 1,I 
      LDB DVTAD     GET NEW DVT ASSIGNMENT
      SZB,RSS       BIT BUCKET? 
      JMP LA.70      YES, FORGET ABOUT LOCK FLAG
*  MOVE LOCK FLAG TO NEW DVT UNLESS IT IS ALREADY LOCKED
      ADB .6        POINT TO DVT 7 OF NEW ASSIGNMENT
      JSB .XLA
      DEF 1,I 
      AND LUMSK     ISOLATE ITS LOCK FLAG 
      SZA           ALREADY LOCKED? 
      JMP ERN36      YES! DISALOW THE LU SWITCH 
      JSB .XLA       NO, MOVE LOCK
      DEF 1,I 
      IOR NUMBA       FLAG FROM PREVIOUS TO NEWLY 
      JSB .XSA         ASSIGNED DVT 
      DEF 1,I 
* 
LA.70 LDA TEMP      PREVIOUS DVT ADDR 
      JSB $SJS1     IN CASE MORE THAN 1 LU ON OLD DVT,
      DEF $SCHD 
      OCT 50         RESCHEDULE LOCK WAITERS
* 
LA.75 LDA TEMP      PREVIOUS DVT ADDR 
      JSB $SJS1     RESCHEDULE ANY WAITERS ON DOWN LIST 
      DEF $SCHD 
      OCT 54         FOR OLD DVT
      LDA TEMP      GET OLD DVT AGAIN 
      JSB $SJS1     RESCHEDULE ANY WAITERS FOR BUFFER LIMITS
      DEF $SCHD 
      OCT 55         FOR OLD DVT
      SKP 
* 
*  NOW MOVE ANY NON-ACTIVE QUEUED REQUESTS TO THE NEW DVT UNLESS
*  THE OLD DVT IS REFERENCED BY ANOTHER LU.  UPDATE BUFFER
*  ACCUMULATORS FOR MOVED CLASS & BUFFERED I/O BLOCKS.  IF
*  ANY REQUESTS ARE MOVED AND THE NEW DVT IS NOT ACTIVE, THE
*  I/O SYSTEM IS CALLED TO INITIATE THE HEAD OF THE DVT 
*  INITIATION LIST. 
      LDB TEMP
      JSB $SJS0     FIND ANY LU REFERENCING OLD DVT 
      DEF $DVLU 
      SZA           ANY LU? 
      JMP LA.90      YES, LEAVE INIT. LIST ALONE
      ADB .5        POINT TO DVT6 
      JSB .XLA      GET "AV"
      DEF 1,I 
      ADB .2
      STB NUMBA     SAVE ADDR OF OLD DVT BUF ACCUMULATOR
      ADB N6        POINT TO DVT2 
      SSA,RSS       IS OLD DEVICE BUSY? 
      JMP NTBUS     NO, IT ISN'T
      JSB .XLB       YES, SKIP HEAD OF INIT LIST
      DEF 1,I 
*  B NOW HAS ADDRESS OF POINTER TO 1ST ENTRY TO BE MOVED
NTBUS ELB,CLE,ERB   CLEAR SIGN
      JSB .XLA      GET ADDR OF 1ST TO MOVE 
      DEF 1,I 
      RAL,CLE,ERA   CLEAR/SAVE SIGN BIT 
      STA TEMP1 
      CLA 
      ERA           MAINTAIN SIGN BIT 
      JSB .XSA      STORE 0 TO MARK END OF LIST 
      DEF 1,I 
*  FIND END OF NEW DVTS CURRENT INITIATION LIST 
      LDB DVTAD     ADDR OF NEW DVT 
      CLA,INA 
      JSB $SJS0     SET DVT LINKS 
      DEF $DIOC 
      JSB .XLA      POINT TO DVT2 
      DEF $DV2
LA.82 LDB 0         GET ADDR OF NEXT
      JSB .XLA      GET LINK TO NEXT
      DEF 1,I 
      RAL,CLE,ERA   CLEAR/SAVE SIGN 
      SZA           END OF INITIATION LIST? 
      JMP LA.82      NO, KEEP GOING 
*  LINK MOVED REQUESTS AT END OF THE NEW DVT'S LIST 
      LDA TEMP1     GET ADDR OF HEAD OF CHAIN TO MOVE 
      RAL,ERA       MAINTAIN SIGN 
      JSB .XSA      ADD CHAIN TO NEW INIT LIST
      DEF 1,I 
*  RECOMPUTE OLD & NEW DVT BUFFER ACCUMULATORS FOR BLOCKS IN SAM
LA.84 LDB TEMP1     GET ADDR OF 1ST MOVED BLOCK 
      SZB,RSS       MORE ON MOVE CHAIN? 
      JMP LA.88      NO 
      JSB .XLA      GET LINK TO NEXT
      DEF 1,I 
      STA TEMP1     SAVE IT 
      INB           POINT TO 2ND WORD IN BLOCK
      JSB .XLA      GET CONWD 
      DEF 1,I 
      RAL 
      SSA,RSS       IS THIS A CLASS OR BUFRD REQ? 
      JMP LA.84      NO, DOESN'T AFFECT ACCUMS
      ADB .6        POINT TO BLOCK SIZE (WORD 8 OF BLOCK) 
      JSB .XLA      GET BLOCK TOTAL SIZE
      DEF 1,I 
      STA TEMP
      JSB .XLA      UPDATE NEW DVT'S ACCUMULATOR
      DEF $DV8
      STA DV8 
      JSB .XLA      GET DV8 
      DEF 0,I 
      ADA TEMP
      JSB .XSA
      DEF DV8,I 
      JSB .XLA      GET SIZE AGAIN
      DEF 1,I 
      CMA,INA 
      STA TEMP
      JSB .XLA      SUBTRACT SIZE FROM OLD DVT'S
      DEF NUMBA,I 
      ADA TEMP
      JSB .XSA       BUFFER ACCUMULATOR 
      DEF NUMBA,I 
      JMP LA.84     ITERATE 
*  CLEAR OLD DVT'S BUFFER-LIMITED FLAG
LA.88 ISZ NUMBA     POINT TO DVT9 OF OLD DVT
      JSB .XLA
      DEF NUMBA,I 
      ELA,CLE,ERA   CLEAR "BUFFER-LIMITED" FLAG (15)
      JSB .XSA
      DEF NUMBA,I 
*  DETERMINE IF NEW DVT IS NOT DOWN & HAS A NON-ACTIVE REQUEST
*  AT THE HEAD OF ITS DVT INITIATION LIST 
      JSB .XLA      GET AV
      DEF $DV6
      JSB .XLA
      DEF 0,I 
      JSB .XLB      GET HEAD OF INIT LIST 
      DEF $DV2
      JSB .XLB
      DEF 1,I 
      ELB,CLE,ERB   CLEAR SIGN
      RAL 
      SZB           INIT LIST EMPTY?
      CMA,SSA,SLA,RSS  IS DEVICE BUSY OR DOWN?
      JMP LA.90         YES, DON'T INITIATE 
*  INITIATE THE HEAD OF THE NEW DVTS INITIATION QUEUE NOW!
*    ( ALL IS KOSHER EVEN IF THIS IS THE BIT BUCKET)
      JSB $SJS0     JUMP INTO I/O SYS FOR LOGICAL INIT
      DEF $UINI 
* 
LA.90 JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
      HED      ******* DISPLAY LU ASSIGNMENT *******
* 
LD.00 LDA M.LU      GET LU #
      JSB DECIM     CONVERT TO ASCII-DECIMAL
      STA M.LU       OF LU
      JSB .XLA      GET LUT ENTRY 
      DEF LUTAD,I 
      SZA,RSS       BIT BUCKET? 
      JMP LD.90      YES
      STA DVTAD     SAVE DVT ADDRESS
*  NOW COMPUTE THIS DVT NUMBER
      CLA,INA 
      STA TEMP
      JSB .XLB      ADDR OF 1ST DVT 
      DEF $DVTA 
LD.10 CPB DVTAD     DVT ADDR MATCH? 
      JMP LD.15      YES
      JSB NXDVT     GET ADDR OF NEXT DVT
      ISZ TEMP
      JMP LD.10     ITERATE 
*  CONVERT DISPLAY VALUES TO ASCII
LD.15 LDA TEMP      GET DVT # 
      JSB DECIM     CONVERT TO 2 DIGIT DECIMAL VALUE
      STA M.DVT     STORE ASCII OF DVT #
      LDB DVTAD 
      ADB .5        ADDR OF DVT6
      JSB .XLA
      DEF 1,I 
      ALF,ALF       RIGHT JUSTIFY DEVICE TYPE 
      JSB OCTAL     CONVERT TO ASCII-OCTAL
      STA M.DTY     STORE DEVICE TYPE IN MSG
      LDB DVTAD 
      ADB .4        DVT5'S ADDR 
      JSB .XLB      GET IFT REF 
      DEF 1,I 
      ELB,CLE,ERB   CLEAR SIGN
      ADB .5        ADDR OF IFT6
      JSB .XLA      GET INTERFACE SELECT CODE 
      DEF 1,I 
      STA TEMP
      JSB OCTAL     CONVERT TO ASCII-OCTAL
      STA M.SC       & STORE IN MSG 
      LDA TEMP      GET IFT6 WORD AGAIN 
      ALF,ALF       RIGHT JUSTIFY INTERFACE TYPE
      JSB OCTAL     CONVERT TO ASCII-OCTAL
      STA M.ITY      & STORE IN MSG 
      LDB MSGLN 
LD.80 STB TEMP
* 
      JSB CNOPT     WRITE RESPONSE LINE 
      DEF *+5 
      DEF .2
      DEF CAM.O 
      DEF MSGBF 
      DEF TEMP
      JMP LA..,I    RETURN
* 
LD.90 LDA ASC.0     BIT BUCKET, SO DISPLAY
      STA M.DVT      DVT # OF ZERO
      LDB .6          & SHORTEN MSG 
      JMP LD.80 
      HED      ******* ROUTINES & CONSTANTS ******* 
ER56  LDA .56       56 = BAD PARAMETER
      STA ERRTN,I   RETURN ERROR VALUE
      JMP LA..,I     AND RETURN 
* 
ERN36 LDA N36       -36 MEANS LOCK ERROR
ERPRV STA ERRTN,I   RETURN ERROR VALUE
      JSB $LIBX     EXIT AND RETURN 
      DEF LA..
* 
* THESE ERRORS ARE ONLY NEEDED IF DVT IFT SWITCHING IS PUT BACK IN
* 
*ER35  LDA .35       IFT SWITCH TO WRONG ITYPE
*      RSS
* 
*ER37  LDA .37       37 = DEVICE BUSY ERROR 
*      JMP ERPRV     PRIVILEDGED WHEN CALLED
* 
*  THESE VARIABLES ARE REQUIRED ONLY FOR DVT,IFT SWITCHING
*DVT5   NOP 
*.35    DEC 35
*.37    DEC 37
* 
* 
*  SUBROUTINE TO CONVERT VALUE TO ASCII-OCTAL 
* 
OCTAL NOP 
      AND B77       JUST USE BITS 5-0 
      JSB CONVT     CONVERT TO ASCII
      DEC 8         BASE 8
      JMP OCTAL,I 
* 
*  SUBROUTINE TO CONVERT VALUE TO ASCII-DECIMAL 
*  2-DIGIT VALUE, SUPPRESSING A LEADING ZERO
* 
DECIM NOP 
      JSB CONVT     CONVERT TO ASCII
      DEC 10        BASE 10 
      JMP DECIM,I 
* 
CONVT NOP 
      CLB 
      DIV CONVT,I 
      SZA           LEADING ZERO? 
      IOR B20        NO, FORM NUMERIC 
      ALF,ALF       LEFT JUSTIFY
      IOR 1         INCLUDE LSB 
      IOR ASC.0     FORM ASCII
      ISZ CONVT 
      JMP CONVT,I   RETURN
* 
*  SUBROUTINE TO COMPUTE ADDR OF NEXT DVT, CURRENT DVT ADDR IN B
* 
NXDVT NOP 
      ADB .20       POINT TO DVT21
      STB CONVT 
      JSB .XLA      GET DVTP LENGTH 
      DEF 1,I 
      CLB 
      RRL 7         RIGHT JUSTIFY DVTP LENGTH IN B
      ADB CONVT     COMPUTE ADDR OF NEXT
      ADB .2          SEQUENTIAL DVT
      JMP NXDVT,I   RETURN
* 
*  THIS SUBROUTINE RETURNS AN ERROR 56 IF ADDRESSED 
*  DVT IS A DISK
CKDSK NOP 
      ADA .5        POINT TO DVT6 
      JSB .XLA      GET IT
      DEF 0,I 
      AND .034      HI BITS OF DEVICE TYPE
      CPA .014      TYPE = 30-37? 
      JMP ER56       YES, DISC, GIVE ERROR
      JMP CKDSK,I   ELSE JUST RETURN
* 
*  DATA AREA
* 
NUMBA NOP 
ERRTN NOP 
LUTAD NOP 
DVTAD NOP 
DV8   NOP 
TEMP  NOP 
TEMP1 NOP 
* 
N1    DEC -1
N36   DEC -36 
.1    DEC 1 
.2    DEC 2 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.20   DEC 20
.56   DEC 56
B20   OCT 20
B77   OCT 77
LUMSK OCT 3770
.034  OCT 34000 
.014  OCT 14000 
N6    DEC -6
ASC.0 ASC 1, 0
* 
* 
MSGBF EQU * 
      ASC 2, LU#
M.LU  BSS 1 
      ASC 2,,DV#
M.DVT BSS 1 
      ASC 2,,DT=
M.DTY BSS 1 
      ASC 2,,SC#
M.SC  BSS 1 
      ASC 2,,IT=
M.ITY BSS 1 
MSGLN ABS *-MSGBF 
* 
* 
      END 
                                                                                                                                                                                                                              