ASMB,R,L,C,Q
* 
*      NAME:     $YCOM  
*      SOURCE:   92067-18442  
*      RELOC:    92067-16260  
*      PGMR:     G.L.M. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 $YCOM,1,10 92067-16260 REV.1903 781201
      ENT $YCOM 
      EXT $STH,$LGON,EXEC,$SHED,$SMLK 
* 
* 
* 
* 
$YCOM JSB EXEC       FETCH STRING FROM SYS\SES CONSOLE (OPSYS)
      DEF ST.1
      DEF .14 
      DEF .1
      DEF BUFF
      DEF DM80
ST.1  EQU * 
* 
      SZA           SEE IF A STRING WAS FOUND 
      JMP OUT       NO STRING -- GO EXIT
* 
* 
      ADB N2        SUBTRACT 2 FOR CALL FLAG
      CMB,INB         ADJUST LENGTH FOR CLASS I\O 
      STB LEN          TRANSFER 
      LDB BUFF       FETCH CALL FLAG
      SZB           0=LOGON 1=R$PN$ 
      JMP BRK        BREAK REQUEST
* 
      JSB EXEC      GET LOGON GOING 
      DEF SCHL
      DEF DS10      SCHED NO ABORT
      DEF LOGON 
SCHL  EQU * 
      NOP           POSSIBLE ERROR RETURN 
* 
      CLA            LOG-ON REQUEST 
* 
* 
      STA OPN1       OPTIONAL PARMS DEFINE CALL TO LOGON
      INA 
      STA OPN2
      LDA $LGON      FETCH LOGON CLASS
* 
DOIT  STA CLAS
* 
      SZA,RSS       IF NO CLASS 
      JMP OUT         GET OUT 
* 
* 
* 
      JSB EXEC       CLASS WRITE\READ REQUEST 
      DEF ST.2
      DEF .20 
      DEF NOP 
      DEF BUFF+1
      DEF LEN 
      DEF OPN1
      DEF OPN2
      DEF CLAS
ST.2  EQU * 
* 
OUT   JSB EXEC
      DEF *+2 
      DEF .6
* 
* 
* 
BRK   JSB EXEC       GET R$PN$ GOING
      DEF SCHR
      DEF DS10
      DEF R$PN$ 
SCHR  EQU * 
      NOP           POSSIBLE ERROR RETURN 
* 
      XLA DRT,I     FETCH F.W. OF DRT 
      AND B77       ISOLATE THE EQT # 
      ADA N1        COUNTS FROM 1 
      MPY D15       OFFSET TO THE EQT FOR LU 1
      ADA D3        OFFSET TO WORD 4
      ADA EQTA      START ADDR OF EQTS
      STA OPN2
* 
      LDA $SMLK     FETCH NEG OFFSET TO SST LEN WORD
      CMA,INA       SET IT POSITIVE 
      ADA $SHED 
      STA OPN1
      LDA $STH
      JMP DOIT
* 
.1    DEC 1 
N1    DEC -1
N2    DEC -2
D3    DEC 3 
D15   DEC 15
DRT   EQU 1652B 
EQTA  EQU 1650B 
.6    DEC 6 
DS10  OCT 100012
LOGON ASC 3,LOGON 
R$PN$ ASC 3,R$PN$ 
.14   DEC 14
.20   DEC 20
BUFF  BSS 40
LEN   NOP 
OPN1  NOP 
OPN2  NOP 
CLAS  NOP 
DM80  DEC -80 
B77   OCT 77
NOP   NOP 
      END $YCOM 
                                    