ASMB,Q,C
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER :92067-18419 
* 
*     RELOCATABLE PART NUMBER : 92067-16363 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
* 
* 
*     ACSES SHUTS DOWN OR RESTARTS
*     THE SESSION SYSTEM SO THAT
*     ACCOUNTS CAN BUILD A NEW
*     ACCOUNT FILE (+@CCT!:-31178:-2
* 
*     CALLING SEQUENCE* 
* 
*C     SHUT DOWN
*C
*      CALL ACSES(-2) 
* 
* 
* 
*     RESTART SESSION 
* 
*      CALL ACSES(0)
* 
      NAM ACSES,7 92067-16363 REV.2001 791020 
      ENT ACSES,LMES,KSPCR,ACFST
      EXT EXEC,.ENTR,$LIBR,$LIBX
      EXT $DSCS,$LGOF,$LGON 
      EXT $LMES,$SPCR,$CL1,$CL2 
* 
IDS1  NOP 
ACSES NOP 
      JSB .ENTR 
      DEF IDS1
* 
      LDA IDS1,I
      JSB $LIBR 
      NOP           GO PRIVILEGED 
      XSA $DSCS+1 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      LDB SNAB
      SZA           IF ZERO A RESTART 
      LDB QSCHD 
      STB SCHDT 
      XLA $DSCS+0 
      SSA           IF $DSCS NEGATIVE JUST RETURN 
      JMP ACSES,I 
* 
* 
*     THEN IT IS A SHUT DOWN CALL 
* 
*     DO CLASS WRITE/READ TO SHUT DOWN LOGON & LGOFF
* 
* 
* 
      XLA $LGON+0 
      LDB LOGON     SHUT DOWN LOGON 
      JSB CLASS 
* 
      XLA $LGOF+0 
      LDB LGOFF     SHUT DOWN LGOFF 
      JSB CLASS 
* 
      JMP ACSES,I   FINISHED
* 
* 
* 
*     CLASS WRITE/READ CALL 
* 
CLASS NOP 
      SZA,RSS 
      JMP CLASS,I 
      STA ICLAS     STUFF CLASS # 
      STB NAME      SET PROGRAM NAME
      LDA IDS1,I
      SZA,RSS       IF ZERO THIS IS START UP
      JMP RTRN2 
      LDA M2
      STA CNT 
* 
CLAS1 JSB EXEC      SEND SHUT DOWN MESSAGE
      DEF RTRN1 
      DEF D20I
      DEF D0
      DEF IDUM
      DEF D0
      DEF SC
      DEF M1
      DEF ICLAS 
RTRN1 NOP 
      ISZ CNT 
      JMP CLAS1     SEND SHUT DOWN TWICE
* 
RTRN2 JSB SCHD
      JMP CLASS,I   AND RETURN
* 
*     PROGRAM SCHEDULE
* 
SCHD  NOP 
SCHD0 JSB EXEC
      DEF RTRN3 
      DEF SCHDT 
NAME  BSS 1 
RTRN3 JMP SCHD,I    RETURN ON ABORT FOR SCHED 
      AND B17 
      IOR IDS1,I    IF QUEUE SCHEDULE OR
      SZA           NOT DORMANT 
      JMP SCHD,I    RETURN
* 
      JSB EXEC      ELSE WAIT 2 SEC 
      DEF RTRN4     AND TRY AGAIN 
      DEF D12 
      DEF D0
      DEF D2
      DEF D0
      DEF M2
RTRN4 JMP SCHD0     GO TRY AGAIN
* 
D0    DEC 0 
* 
D20I  OCT 100024
A     EQU 0 
B     EQU 1 
SNAB  OCT 100012
QSCHD OCT 100027
M1    DEC -1
M2    DEC -2
LOGON DEF *+1 
      ASC 3,LOGON 
LGOFF DEF *+1 
      ASC 3,LGOFF 
SC    DEC -31178
ICLAS BSS 1 
IDUM  BSS 1 
SCHDT BSS 1 
* 
* 
* 
* 
*     LMES PUTS THE PROMPT STRING INTO MEMORY 
*          STARTING AT $LMES
* 
*     CALLING SEQUENCE: 
*       CALL LMES(ICNT,IPRMPT,IDSC1)
*C
*C        WHERE ICNT   IS NEGATIVE NUMBER OF CHARS IN STRING
*C              IPRMPT IS 10 WORD PROMPT STRING 
*C              IDSC1  IS VALUE TO BE PUT IN $DSCS+1
* 
JBCNT NOP 
JBUF  NOP 
IDSC1 NOP 
LMES  NOP 
      JSB .ENTR 
      DEF JBCNT 
* 
      LDB LMESS     ADDRESS OF $LMES
      LDA DM11      SET UP WORD COUNT 
      STA CNT 
      JSB $LIBR 
      NOP 
      LDA JBCNT,I   GET BYTE COUNT
LOOP8 XSA B,I       STUF INTO LMESS 
      LDA JBUF,I    FETCH TWO CHARS 
      ISZ JBUF
      INB 
      ISZ CNT 
      JMP LOOP8 
* 
      LDA IDSC1,I   STUFF $DSCS+1 
      XSA $DSCS+1 
      JSB $LIBX 
      DEF LMES
* 
LMESS DEF $LMES+0 
DM11  DEC -11 
CNT   BSS 1 
* 
*     KSPCR  FETCHES $SPCR
* 
*     CALLING SEQUENCE: 
*       I=KSPCR(IDUM) 
*           WHERE IDUM IS A DUMMY PARAMETER 
* 
KSPCR NOP 
      XLA $SPCR+0 
      LDB KSPCR,I 
      JMP B,I 
* 
*     ACFST  READS CARTRIDGE LIST 
*        CALLING SEQUENCE:
*          CALL ACFST(MBUF) 
*           WHERE: MBUF IS A 256 WORD BUFFER
* 
MBUF  NOP 
ACFST NOP 
      JSB .ENTR 
      DEF MBUF
* 
      JSB EXEC      GO READ CARTRIDGE LIST
      DEF ACFRT 
      DEF D1
      DEF D2
      DEF MBUF,I
      DEF D256
      DEF $CL1
      DEF $CL2
ACFRT LDA DM64      SETLOOP COUNTER 
      STA CNT 
      LDB MBUF
      ADB D3
ACFLP LDA B,I       GET ID VALUE
      AND B7777     MASK
      STA B,I 
      ADB D4
      ISZ CNT 
      JMP ACFLP 
      JMP ACFST,I   RETURN
* 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D12   DEC 12
B17   OCT 17
B7777 OCT 7777
DM64  DEC -64 
D256  DEC 256 
      END 
          