ASMB,R,L,C
      HED "LOGON" AMD SESSION LOGON ROUTINE 9-76 (DLB)
*     NAM LOGON,2,50 09570-16654 REV. A 761110
*     NAM LOGON,2,50 09570-16654 REV. B 761129
      NAM LOGON,1,40 PRE-REL REV. D 780512 (DLB) RTE-IV 
* 
*-------------------------------------------------------- 
* 
*     RELOC.       09570-16654
*     SOURCE       09570-18654
* 
*     D. L. BASKINS      13 OCT 76 REV. A 
* 
*-------------------------------------------------------- 
      EXT EXEC,CLAS%
      EXT KYBRD,ICLRW,.XLA
A     EQU 0 
B     EQU 1 
      SPC 1 
*  :RUIH,LOGON,<LU>            TO OUTPUT LOGON MESSAGE
      SPC 1 
LOGON NOP           ENTRY 
      JSB .XLA      GET THE LOGICAL UNIT OF TERMINAL
      DEF B,I 
      STA LU        SAVE
      IOR O400      FORM LU WITH PRINT BIT
      STA RLU 
      IOR O2400 
      STA CNWD1     SAVE UNFLUSH COMMAND
      JSB EXEC      SWAP ONLY ME
      DEF *+3 
      DEF D22 
      DEF O2
      JSB EXEC      GET RID OF ANY STRING MEMORY NOW
      DEF *+5 
      DEF D14 
      DEF O1
      DEF LENTH     SCRATCH LOCATION
      DEF O1        ANY CONVIENENT LENGTH 
      JSB KYBRD     CHECK IF LEGAL KEYBOARD LOGICAL UNIT? 
      DEF *+2 
      DEF LU
      SSA           LEGAL?
      JMP EXIT      NO, IGNORE THE REQUEST
      LDA CLASS     CHECK IF ENTRY POINT EXISTS?
      SZA,RSS       EXISTS? 
      JMP ERR2      NO, EXIT
      RSS           YES, FORCE TO DIRECT ADDRESS
      LDA A,I       GET NEXT LEVEL
      RAL,CLE,SLA,ERA STRIP BIT 15 AND TEST 
      JMP *-2 
      STA CLASS     SAVE DIRECT ADDRESS 
      SPC 1 
      JSB ICLRW     GO DO A BUFFER UNFLUSH
      DEF *+4 
      DEF O3        CONTROL REQUEST 
      DEF CLASS     ADDRESS OF CLASS WORD IN SYSTEM MAP 
      DEF CNWD1 
      SZA           CHECK IF ANY ERRORS 
      JMP ERR3      YES, IGNORE 
      JSB ICLRW     NOW OUTPUT A CR/LF
      DEF *+4 
      DEF O2
      DEF CLASS 
      DEF LU
      JSB ICLRW     NOW OUTPUT THE PLEASE LOGON MESSAGE 
      DEF *+7 
      DEF O2
      DEF CLASS 
      DEF LU
      DEF O0
      DEF PLGON 
      DEF PLLEN 
      JSB ICLRW     NOW DO THE CLASS READ 
      DEF *+7 
      DEF O1
      DEF CLASS 
      DEF RLU 
      DEF O0        LOGON FLAG >> OPT 1 = 0 
      DEF O0        DUMMY BUFFER ADDRESS
      DEF D20       INPUT 40 CHARACTERS MAX 
      SZA           CHECK IF ANY ERRORS?
      JMP ERR3
      JSB EXEC      NOW SCHEDULE "LSPNS"
      DEF *+3 
      DEF NA10
      DEF LSPNS 
      JMP ERR1      LSPNS MISSING 
EXIT  JSB EXEC      ALL OK, TERMINATE 
      DEF *+4 
      DEF O6
      DEF O0
      DEF OM1       SERIAL RE-USABLE
      SPC 1 
ERROR NOP           ENTRY TO OUTPUT ERROR MESSAGE 
      LDA ERROR,I   GET MESSAGE LENGTH
      STA LENTH 
      ISZ ERROR 
      JSB EXEC      USE STANDARD EXEC CALL
      DEF *+5 
      DEF O2
      DEF LU
      DEF ERROR,I 
      DEF LENTH 
      JMP EXIT      AND EXIT
      SPC 1 
CNWD1 NOP 
LU    NOP 
RLU   NOP 
LENTH NOP 
      SPC 1 
PLLEN DEC 8 
PLGON ASC 8,PLEASE LOG ON: _  PLEASE LOG ON:
      SPC 1 
ERR1  JSB ERROR     WRITE OUT LSPNS MISSING MESSAGE 
      DEC 16
LSMIS ASC 16,PROGRAM LSPNS MISSING >> ABORT 
LSPNS EQU LSMIS+4 
ERR2  JSB ERROR     WRITE OUT CLAS% ENTRY MISSING 
      DEC 15
      ASC 15,CLAS% ENTRY MISSING >> ABORT 
      SPC 1 
ERR3  JSB ERROR     WRITE OUT TOO LITTLE S.A.M. 
      DEC 18
      ASC 18,INSUFFICIENT SYSTEM MEMORY >> ABORT
O400  OCT 400 
O2400 OCT 2400
O0    OCT 0 
O1    OCT 1 
O2    OCT 2 
O3    OCT 3 
O6    OCT 6 
D14   DEC 14
D20   DEC 20
D22   DEC 22
NA10  ABS 10+100000B
OM1   OCT -1
CLASS DEF CLAS%+0 
      END LOGON 
                                                                                                                        