.title gcl..devclass
;-----
;  routines IS_<device>
;  entry points:
;     IS_TERM         IS_TAPE
;     IS_DISK         IS_SCOM
;     IS_MBOX         IS_LP
;  author:
;     Grec -- 11/29/83
;  format:
;     0/1  =  IS_device(  devnam.rt.dx  )
;  arguments:
;     p1 = addr of descr to string containing device name
;  registers:
;     r2 = addr of descr to (old or new) string
;+++++

;-----
;  routine GET_DEVCLASS
;  author:
;     Grec -- 11/29/83
;  format:
;     status  =  get_devclass(  devnam.rt.dx,  class.wl.r  )
;  arguments:
;     p1 =  addr of descr to string containing device name
;     p2 =  addr of longword to recieve devclass
;  registers:
;     r2 =  addr of scratch descr
;     r6 =  addr of working descr
;+++++

;  constants:
      c_blank = ^a/ /
      c_colon = ^a/:/
;  definitions:
      $dvidef
      $dcdef
;------------------------------------------------------------------------------
      .subtitle gcl..match_devclass
;
;  to compare a device's devclass with that value desired.
;
      .entry is_disk, ^m<r2>
      movl    #dc$_disk, r2
      brb     match_main

      .entry is_term, ^m<r2>
      movl    #dc$_term, r2
      brb     match_main

      .entry is_mbox, ^m<r2>
      movl    #dc$_mailbox, r2
      brb     match_main

      .entry is_tape, ^m<r2>
      movl    #dc$_tape, r2
      brb     match_main

      .entry is_scom, ^m<r2>
      movl    #dc$_scom, r2
      brb     match_main

      .entry is_lp, ^m<r2>
      movl    #dc$_lp, r2
      brb     match_main

match_main:
      clrl    -(sp)                   ; alloc space to recieve device type
      pushal  (sp)                    ; push addr of buffer
      pushaq  @4(ap)                  ; push addr of string descr
      calls   #2, get_devclass        ; call get_device
      cmpl    (sp), r2                ; check for match
      bnequ   no
yes:  movl    #1, r0
      ret
no:   movl    #0, r0
      ret
;------------------------------------------------------------------------------
      .subtitle gcl..get_devclass
;
; to check input string, add colon if necessary, get devclass
;
      .entry get_devclass, ^m<r2,r3,r4,r5,r6>

      movaq   @4(ap), r2              ; r2 = addr of working descr
      locc    #c_colon, (r2), @4(r2)
      bnequ   colon
no_colon:                             ; push new string, add colon
      decl    sp                              ; alloc space for new string
      movzwl  (r2), r0
      subl2   r0, sp
      moval   (sp), -(sp)                     ; 4(r6) = addr of newstr
      pushl   (r2)                            ;  (r6) = len of newstr
      moval   (sp), r6                        ;   r6  = addr of newstr descr

      skpc    #c_blank, (r2), @4(r2)          ; skip leading blanks (oldstr)
                                              ; r0 <- newlen, r1 <- newaddr
      movl    r0, (r6)                        ; fill in newlen in newdesc
      movc3   (r6), (r1), @4(r6)              ; copy str to newstr

      locc    #c_blank, (r6), @4(r6)          ; find first blank
      movb    #c_colon, (r1)                  ; replace it with colon
      subl2   r0, (r6)                        ; set new length

      movaq   (r6), r2                        ; set curr-str to new str

colon:
      clrq    -(sp)                   ; push long to recieve outlen
                                      ; push itmlst
                                              ; terminator 0
      pushal  4(sp)                           ; addr of outlen
      pushal  @8(ap)                          ; addr of buf
      movw    #dvi$_devclass, -(sp)   ; item code         /
      movw    #4, -(sp)                       ; buff len         /
      movab   (sp), r0                        ; r0 = addr of itmlst

      clrq    -(sp)                   ; call sys$getdvi
      clrq    -(sp)                           ; four null args
      pushal  (r0)                            ; addr of itmlst
      pushaq  (r2)                            ; addr of string descr
      clrq    -(sp)                           ; two null args
      calls   #8, g^sys$getdvi        ; return status
      ret
;-----------------------------
      .end