ASMB,R,L,C,Q
*     NAME:   LSUB1 
*     SOURCE: 92067-18265 
*     RELPC:  92067-16260 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 LSUB1,8 92067-16260 REV.2026 800414 
* 
* 
* 
      EXT $LGON,$SMLK,$SMST,$SMCA,$SMID,$SMGP,$SMDL 
      EXT .ENTR,$CVT1,$CVT3,LCLAS,VERSN,$DSCS,$SMD#,$SMER 
      EXT CCLAS,SESID,INTER,$CL1,$CL2,EXEC
      ENT INIT,MKSST,CONV,LPARS,FSTAA 
* 
      SUP 
* 
* 
A     EQU 0 
B     EQU 1 
* 
      SKP 
* 
      SPC 5 
* 
* 
* 
* 
*     LGON INITIALIZATION ROUTINE 
* 
* 
LGON  NOP 
ID    NOP 
DIR#  NOP 
CAP   NOP 
EROF  NOP 
UID   NOP 
GID   NOP 
DLMT  NOP 
SSTL  NOP 
DSCS2 NOP 
* 
INIT  NOP 
      JSB .ENTR 
      DEF LGON
* 
      OCT 101724    FETCH BUSY FLAG  (XLA)
      DEF $DSCS+1 
      STA DSCS2,I    AND RETURN IT
* 
      CCA           PRESET (A) FOR POSSIBLE NOT INITIALIZED ERROR RETURN
      XLB $LGON      FETCH GLOBAL CLASS NUMBER FOR LOGON'S
      SZB,RSS        IF NOT DEFINED,ERROR FOR NOW 
***** 
      JMP INIT,I
* 
      LDA B 
* 
      IOR B20K      ADD DON'T DEALLOCATE BIT
      STA LGON,I    TO CLASS AND RETURN IT TO CALLER
      STA LCLAS     ALSO DEFINE THE CLASS FOR MESSP 
* 
      XLA $DSCS     FETCH SESSION STATUS FLAG 
      SSA           IF NOT UP AND GOING,
      JMP INIT,I      RETURN STATUS IN (A)
* 
* 
*     ALL OFFSETS ARE FROM THE FIRST WORD BUILT BY THE
*     CALLER OF MKSCB, WHICH IS THE SESSION ID. 
* 
*     CALCULATE DISTANCE FROM LENGTH WORD TO SESSION ID 
* 
      LDB $SMLK     FETCH -LENGTH FROM SST LENGTH WD TO LINK
      ADB $SMST     ADD POS LENGTH (FROM LINK TO SESSION ID)
      CMB,INB       SET RESULT POSITIVE 
      STB OFF1      SAVE IT FOR "MKSST" 
* 
      INB           ARRAY ARGUMENTS COUNT FROM 1, NOT ZERO. 
* 
      STB SSTL,I    SAVE ELEMENT NUMBER FOR SST LENGTH WORD 
* 
* 
*     CALCULATE THE REST OF THE OFFSETS 
* 
* 
      LDA $SMD#     OFFSET TO DIRECTORY ENTRY NUMBER
      ADA B 
      STA DIR#,I
* 
      LDA $SMCA     FETCH CAPABILITY OFFSET 
      ADA B         CONVERT IT TO COUNT FROM SESSION IDENTIFIER 
      STA CAP,I     RETURN IT 
* 
      LDA $SMER     OFFSET TO ERROR PARAMETER 
      ADA B         CONVERT IT
      STA EROF,I    RETURN RESULT 
* 
      LDA $SMID     FETCH USER ID OFFSET
      ADA B         CONVERT IT
      STA UID,I     RETURN IT 
* 
      LDA $SMGP     FETCH GROUP ID OFFSET 
      ADA B         CONVERT IT
      STA GID,I     RETURN IT 
* 
      LDA $SMDL     FETCH OFFSET TO DISC LIMIT
      ADA B         CONVERT IT
      STA DLMT,I    RETURN IT 
* 
* 
      CLA,INA       SCB WORD 1 IS IDENTIFIER
      STA ID,I
* 
      CLA 
      STA VERSN     ALLOW SECOND LINE TO BE ISSUED BY MESSP 
      JMP INIT,I    GET OUT 
* 
      SPC 5 
B20K  OCT 20000 
      SKP 
* 
OFF1  NOP 
* 
* 
* 
* 
* 
* 
* MAKE AN SST ADDITION
* 
SCBAD NOP 
NEWSW NOP 
OFFST NOP 
STAT  NOP 
* 
MKSST NOP 
      JSB .ENTR 
      DEF SCBAD 
* 
      LDA SCBAD     FETCH SCB ADDRESS 
      ADA OFF1      POSITION AT SST LENGTH WORD 
      STA SSTLN     SAVE THAT LOCATION
      ADA OFFST,I   ADVANCE TO FIRST SWITCH PAST LU 1 DEFINITION
      STA SCBAD     SAVE THAT LOCATION ALSO 
* 
      LDA DM70      FETCH SIZE OF MAX SST 
      ADA SSTLN,I   CHECK CURRENT SIZE
      SSA,RSS       IF ALREADY MAX SIZE,
      JMP NOROM     GET OUT 
* 
      LDA NEWSW,I   FETCH NEW SST ENTRY 
      AND B377      ISOLATE SESSION LU
      STA SYRES     SAVE SESSION LU 
* 
NEXT  CLA            PRESET FOR OK RETURN 
      LDB NEWSW,I   FETCH NEW SST ENTRY 
      CPB SCBAD,I   COMPARE IT TO AN EXISTING ENTRY 
      JMP MKSST,I   IF COMPLETE DUPLICATE, JUST IGNORE IT 
* 
      LDA SCBAD,I   FETCH CURRENT SST ENTRY 
      SZA,RSS       IS THIS THE FREE AREA 
      JMP HOLE      YEP-YOU WIN 
* 
      AND B377      ISOLATE SESSION LU
      CPA SYRES     IF DUPLICATE ON SESSION SIDE
      JMP DUPER     RETURN DUP STATUS 
* 
      ISZ SCBAD     BUMP SST POINTER
      JMP NEXT      GO CHECK NEXT SWITCH
* 
* 
DUPER LDA SCBAD,I   RETURN SST VERSION
      STA STAT,I     OF EXISTING DUPLICATE ENTRY
      CCA           SET A < 0 FOR ERROR RETURN
      JMP MKSST,I   RETURN
* 
* 
HOLE  STB SCBAD,I   ADD NEW ENTRY 
      ISZ SSTLN,I   BUMP SST COUNT
      CLA,RSS       A=0 FOR GOOD RETURN 
* 
NOROM CLA,INA       FULL STATUS RETURN
      JMP MKSST,I 
      SPC 10
B377  OCT 377 
DM70  DEC -70 
DBLKS DEF BLKS
BLKS  ASC 11, 
DGEN  DEF GEN 
GEN   ASC 4,GENERAL 
.     OCT 56
/     OCT 57
D10   DEC 10
D1    DEC 1 
D2    DEC 2 
D252  DEC 252 
D11   DEC 11
D6    DEC 6 
D4    DEC 4 
D7    DEC 7 
NULL  OCT 40
* 
      SKP 
* 
* 
* 
*   CONVERT THE SYSTEM AND SESSION LU'S OF AS SST ENTRY 
* 
* 
* 
SWIT  NOP 
SYRES NOP 
SERES NOP 
* 
CONV  NOP 
TLOG  EQU CONV      USE ENT FOR TEMP. 
SSTLN EQU CONV
      JSB .ENTR 
      DEF SWIT
* 
      CLB,CCE       SET E FOR DECIMAL CONVERSION
      LDA SWIT,I    FETCH SST ENTRY TO BE CONVERTED 
      ASL 8         PUT SYSTEM LU IN B
      ALF,ALF        REPOSITION SESSION LU
      INA           (INTERNAL STRUCTURE IS LU-1)
      JSB $CVT1     GO CONVERT SESSION LU 
      STA SERES,I   STORE RESULT IN CALLER'S BUFFER 
      LDA B         FETCH SYSTEM LU 
      INA           (INTERNAL STRUCTURE IS LU-1)
      JSB $CVT3 
      INA           ADVANCE TO LAST 4 DIGITS
      DLD A,I         AND FETCH THEM
      DST SYRES,I       THEN SET THEM IN USER'S BUFFER
      JMP CONV,I
* 
* 
      SKP 
* 
* 
* 
* 
*  PARSE THE USER.GROUP/PASSWORD NAMES
* 
* 
BUF   NOP 
LEN   NOP 
U/G   NOP 
PASS  NOP 
* 
LPARS NOP 
      JSB .ENTR 
      DEF BUF 
* 
      LDA BUF       FETCH INPUT BUFFER ADDR 
      RAL           GET BYTE ADDRESS
      STA BUF       SAVE FOR SCAN 
* 
      LDA LEN,I     FETCH BYTE COUNT
      STA LEN       SAVE IN LOCAL TEMP
      SSA           IF NEGATIVE, THIS IS A PASSWORD PARSE ONLY
      JMP PPAS      SO GO PARSE THE PASSWORD
* 
      CMA,INA,SZA,RSS SET BYTE COUNT NEG AND CHECK FOR ZERO 
      JMP LPARS,I   RETURN IF NULL
* 
      STA LEN       SAVE NEG BYTE COUNT 
* 
*     PARSE THE USER NAME 
* 
      LDB U/G       FETCH ADDR OF USER/GROUP RESULT FIELD 
      LDA DBLKS     FETCH ADDR OF ASCII BLANKS
      MVW D11       PAD RESULT FIELD WITH BLANKS
* 
      LDA U/G       FETCH U/G BUFFER ADDR 
      INA           ADVANCE PAST COUNT
      JSB SCAN      GO PARSE IT 
* 
      LDB TLOG      FETCH COUNT OF BYTES IN USER NAME 
      BLF,BLF       POSITION TO HIGH BYTE 
      STB U/G,I     SAVE FOR RETURN 
      SZB,RSS       IF USER NAME NOT GIVEN
      JMP LPARS,I   ERROR--RETURN 
* 
      LDB LEN       FETCH REMAINING INPUT BYTE COUNT
      SZB,RSS       IF OUT OF INPUT, GO DEFAULT GROUP NAME
      JMP MGEN
* 
      CPA /         FIND GROUP TERMINATOR ? 
      JMP MGEN      YES-- GO DEFAULT GROUP NAME 
* 
      CPA .         FIND USER TERMINATOR ?
      JMP GRUP      YES GO SCAN FOR GROUP NAME
* 
* 
*  END OF LINE. DEFAULT GROUP NAME TO "GENERAL" 
* 
* 
* 
MGEN  LDA DGEN      FETCH  ADDR OF GEN GRUP 
      LDB U/G       FETCH USER/GROUP RESULT FIELD 
      ADB D6        ADVANCE TO GROUP LOCATION 
      MVW D4        MOVE THE GENERAL GROUP NAME IN
* 
      LDA D7
UPLEN ADA U/G,I     SET GROUP LEN AT 7 BYTES
      STA U/G,I 
* 
      LDA LEN       FETCH REMAINING INPUT COUNT 
      SZA           IF PASSWORD TO BE PARSED
      JMP PPAS      GO DO IT
* 
      STA PASS,I    SET PASSWRD LENGTH AT ZERO
      JMP LPARS,I   GET OUT 
* 
      JMP LPARS,I    GET OUT
* 
      SPC 5 
* 
*     PASSWORD PARSE
* 
PPAS  LDB PASS      FETCH RESULT BUFFER 
      LDA DBLKS     FETCH ADDR OF ASCII BLANKS
      MVW D6        BLANK OUT RESULT BUFFER 
* 
      LDA PASS      FET ADDR OF RESULT FIELD
      INA           ADVANCE PAST LENGTH 
      JSB SCAN
* 
      LDA TLOG      FETCH CHAR COUN OF PASSWORD 
      STA PASS,I    SAVE FOR RETURN 
      JMP LPARS,I 
* 
* 
      SPC 10
* 
*     PARSE GROUP NAME
* 
GRUP  LDA U/G       FETCH USER/GROUP RESULT BUFFER
      ADA D6        ADVANCE TO GROUP LOCATION 
      JSB SCAN      GO PARSE IT 
* 
      CLB           IF USER TERMINATOR
      CPA .           FOUND, TERMINATE PARSE
      STB LEN 
* 
      LDA TLOG      FETCH CHAR COUNT
      SZA           ANY THING FOUND 
      JMP UPLEN     WE HAVE A GROUP--GO UPDATE LENGTH 
      JMP MGEN      NOTHING-- GO FILL WITH "GENERAL"
* 
* 
      SPC 10
* 
* 
*     SCAN THE INPUT BUFFER UNTIL A "." OR "/" OR END OF LINE 
* 
* 
* 
SCAN  NOP 
      RAL           GET A BYTE ADDR 
      STA SERES     SAVE IT 
* 
      CLA,CCE        CLEAR BYTE COUNT 
      STA TLOG
NXBYT LDB BUF       FETCH INPUT BUFFER BYTE ADDR (CURENT) 
      LBT           GET A BYTE
      STB BUF       SET NEXT BYTE ADDR
      CPA NULL      BLANK ? 
      JMP SCAN2     GET NEXT BYTE 
* 
      CPA .         USER TERMINATOR ? 
      JMP SCAN3     YEP-GET OUT 
* 
      CPA /         GROUP TERMINATOR ?
      JMP SCAN3     YEP - GET OUT 
* 
      LDB TLOG      FETCH CURRENT RESULT BYTE COUNT 
      CPB D10       IS RESULT BUFFER FULL ? 
      JMP SCAN2     YEP - GET NEXT CHARACTER
* 
      LDB SERES     FETCH RESULT BYTE ADDR
      SBT           SET THE BYTE
      STB SERES     SAVE NEW RESULT ADDR
      ISZ TLOG      BUMP BYTE COUNT 
* 
SCAN2 CLE           FORCE ANOTHER PASS (UNLESS END OF LINE) 
* 
SCAN3 ISZ LEN       BUMP INPUT CHAR COUNT 
      SEZ,CCE       IF NOT END OF LINE, TERMINATOR FOUND ?
      JMP SCAN,I    EOL OR TERMINATOR FOUND 
      JMP NXBYT 
* 
      SKP 
* 
* 
BUFX  NOP 
FSTAA NOP 
      JSB .ENTR 
      DEF BUFX
* 
      JSB EXEC
      DEF STF.1 
      DEF D1
      DEF D2
      DEF BUFX,I
      DEF D252       LAST 4 WORDS DON'T CONCERN US
      DEF $CL1
      DEF $CL2
STF.1 EQU * 
      JMP FSTAA,I 
      END