ASMB,R,L,C
*     NAME:   ME.SB 
*     SOURCE: 92067-18450 
*     RELOC:  92067-16125 
*     PGMR:   R.D.
* 
*  ***************************************************************
*  * (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 ME.SB,8 92067-16125 REV.1903 790510 
      ENT ME.SB 
      EXT .ENTR     PARAMETER FETCH ROUTINE 
      EXT $SMD#     OFFSET TO DIRECTORY ENTRY # IN SCB
      EXT $SMID     OFFSET TO USER ID IN SESSION CONTROL BLOCK
      EXT CLOSE     FMP FILE CLOSE ROUTINE
      EXT CREAT     FMP FILE CREATE ROUTINE 
      EXT I.BUF     INTERNAL (FMGR) DCB 
      EXT ISMVE     MOVE WORDS FROM SESSION CONTROL BLOCK 
      EXT LOCF      FMP FILE LOCATION ROUTINE 
      EXT N.OPL     FMGR 10-WORD SUBPARAMETER ARRAY 
      EXT O.BUF     INTERNAL (FMGR) DCB 
      EXT OPEN      FMP FILE OPEN ROUTINE 
      EXT OPEN.     INTERNAL FMGR OPEN ROUTINE
      EXT OPENF     FMP OPEN FOR TYPE 0 FILES 
      EXT OVRD.     SESSION OVERRIDE OPTION WORD
      EXT POSNT     FMP FILE POSITION ROUTINE 
      EXT PURGE     FMP FILE PURGE ROUTINE
      EXT READF     FMP FILE READ ROUTINE 
      EXT RNRQ      EXEC REQUEST FOR RESOURCE NO. 
      EXT SESSN     DETERMINES IF IN SESSION
      EXT WRITF     FMP WRITF 
      EXT XLUEX     EXTENDED LU EXEC CALL 
* 
A     EQU 0 
B     EQU 1 
* 
*     GET INPUT STRING AND PARSE IT 
* 
IBUFR NOP           PARM 1 (TYPE,NAMR)
IPURG NOP           OPTION WORD TO PURGE MESSAGE FILE 
IERR  NOP           ERROR RETURN WORD 
ME.SB NOP           SUBROUTINE ENTRY POINT
* 
      JSB .ENTR 
      DEF IBUFR 
* 
      LDA IBUFR,I   CHECK FIRST PARAMETER (LIST DEVICE) 
      SZA           NOT SUPPLIED? 
      JMP ME.1      CHECK IF ASCII OR NUMERIC 
      STA RDERR     INITIALIZE FOR READ ERROR 
      STA CLEAN 
      INA           DEFAULT LIST TO 1 
      STA INAM      SAVE IT 
      JMP ME.5
ME.1  LDB ADIBF,I   ADDRESS OF PARAMETER ARRAY
      INB 
      CPA D3        ASCII?
      JMP ME.2      YES 
      CPA D1        NUMERIC?
      JMP ME.4      YES 
      LDA D56       ERROR - BAD PARAMETER 
      STA IERR,I    RETURN ERROR
      JMP ME.SB,I   RETURN
ME.2  CMA,INA       SET -3 AS COUNTER 
      STA CTR       SAVE IT 
      LDA ADINM     POINTER TO INAM 
      STA TEMP
ME.3  LDA B,I       GET 1ST 2 CHARACTERS OF NAMR
      STA TEMP,I    SAVE IT 
      ISZ TEMP
      INB           BUMP SOURCE ADDRESS 
      ISZ CTR       INCREMENT COUNTER 
      JMP ME.3      MOVE NEXT 2 CHARACTERS OF NAMR
      JMP ME.5
ME.4  LDA B,I       GET LU
      STA INAM      SAVE IT 
* 
ME.5  JSB SESSN     IN SESSION
      DEF *+2 
      DEF XEQT      CURRENTLY EXECUTING PROGRAM 
      SEZ,RSS       SKIP IF NON-SESSION 
      JMP L2        IN SESSION
      LDA D45       NON-SESSION 
      STA IERR,I    ERROR - SESSION COMMAND ONLY
      JMP ME.SB,I 
L2    STB ADSCB     SAVE SCB ADDRESS
* 
      JSB ISMVE     MOVE USER ID FROM SCB 
      DEF RTN44 
      DEF ADSCB     SCB ADDRESS 
      DEF $SMID     OFFSET TO USER ID IN SCB
      DEF USRID     USER ID RETURNED HERE 
      DEF D1        1 WORD TO BE MOVED
RTN44 EQU * 
* 
      LDA SECU
      STA NOPL
      LDA OVRD.     GET SESSION OVERRIDE FLAG 
      STA TEMP      SAVE IT'S CURRENT STATE 
      IOR M2000     SET TO ALLOW SYS DISC WRITE 
      STA OVRD.     SAVE IT 
      JSB OPEN.     OPEN ACCOUNT FILE 
      DEF RTN4
      DEF I.BUF     ACCOUNT FILE DCB
      DEF ACCT      ACCOUNT FILE = +@CCT! 
      DEF NOPL
      DEF IOPTN     OPTION WORD 
RTN4  EQU * 
      LDA TEMP
      STA OVRD.     RESET OVERRIDE FLAG 
* 
*     READ ACCOUNT FILE HEADER
* 
      JSB READF 
      DEF RTN5
      DEF I.BUF     DCB OF ACCOUNT FILE 
      DEF JERR      ERROR RETURN WORD 
      DEF IBUF      BUFFER LOCATION 
      DEF D128      ONE RECORD LENGTH 
      DEF LEN       NUMBER OF WORDS READ
RTN5  EQU * 
* 
* 
      LDA DFIBF     GET LOCATION OF BUFFER
      ADA D24       OFFSET TO RESOURCE NUMBER 
      LDA A,I 
      STA RESNO 
* 
      JSB RNRQ      LOCK ACCT FILE RESOURCE NBR 
      DEF RTN40 
      DEF D1        REQUEST TO SET LOCAL RN 
      DEF RESNO     ACCT FILE RESOURCE NUMBER 
      DEF ISTAT     STATUS RETURN WORD
RTN40 EQU * 
* 
      JSB READF     RE-READ ACCOUNT FILE HEADER 
      DEF RTN7
      DEF I.BUF     ACCOUNT FILE DCB
      DEF JERR      ERROR RETURN WORD 
      DEF IBUF
      DEF D128
      DEF LEN       NUMBER OF WORDS READ
      DEF D1        ACCOUNT FILE RECORD 1 
RTN7  EQU * 
* 
      LDA DFIBF     START OF BUFFER IBUF
      STA B 
      ADA D4
      LDA A,I       RECORD # OF DIRECTORY 
      STA DIRNO 
      ADB D25 
      LDA B,I       LU # OF MSG FILES 
      STA LUNO. 
* 
*     FIND USER'S DIRECTORY ENTRY 
* 
      JSB ISMVE     GET DIRECTORY ENTRY # FROM SCB
      DEF RTN55 
      DEF ADSCB     SESSION CONTROL BLOCK ADDRESS 
      DEF $SMD#     OFFSET TO DIRECTORY ENTRY # IN SCB
      DEF DNUM      DIRECTORY ENTRY # RETURN WORD 
      DEF D1        1 WORD TO BE MOVED
RTN55 EQU * 
* 
      LDA DNUM      GET DIRECTORY ENTRY # 
      CLB           COMPUTE ACCT FILE RECORD # WITH THIS ENTRY
      DIV D8
      ADA DIRNO     ADD RECORD # OF START OF DIRECTORY
      STA DNUM      SAVE RECORD NUMBER CONTAINING DIRECTORY ENTRY 
      BLF           COMPUTE OFFSET INTO RECORD IN WORDS 
      STB TEMP      TEMPORARY SAVE
      JSB READF     READ RECORD CONTAINING DIRECTORY ENTRY
      DEF RTN56 
      DEF I.BUF     ACCOUNT FILE DCB
      DEF JERR      ERROR RETURN WORD 
      DEF IBUF      RETURN BUFFER 
      DEF D128
      DEF LEN       NUMBER OF WORDS ACTUALLY READ 
      DEF DNUM      ACCOUNT FILE RECORD NUMBER
RTN56 EQU * 
* 
      LDA DFIBF     ADDRESS OF START OF IBUF
      ADA TEMP      OFFSET TO START OF DIRECTORY ENTRY
      ADA D14       OFFSET TO USER ENTRY RECORD NUMBER
      LDA A,I 
      CLB           SET OFFSET TO 0 
      SSA           SIGNED MEANS ACCT IN 2ND HALF OF RECD 
      LDB D64       YES, ACCOUNT IS IN 2ND 64 WORDS 
      STB OFFST     NO ACCOUNT IS IN 1ST 64 WORDS 
      AND M7777     REMOVE SIGN BIT 
      STA USACT     USER ACCOUNT RECORD # 
* 
* 
*     NOW READ IN USER ACCOUNT ENTRY
* 
      JSB READF     READ IN USER ACCOUNT FILE 
      DEF RTN12 
      DEF I.BUF 
      DEF JERR
      DEF UBUF      BUFFER FOR USER ACCOUNT 
      DEF D128      WHILE RECORD IS READ
      DEF LEN 
      DEF USACT 
RTN12 EQU * 
* 
*     CHECK TO SEE IF MAIL IS WAITING IF SO THEN OPEN MESSAGE FILE
*     OTHERWISE REPORT NO MAIL IS WAITING 
* 
      LDA ADBUF     ADDR OF BUFFER CONTAINING ACCOUNT 
      ADA D20       OFFSET TO CARTRIDGE WORD
      ADA OFFST     ADD IN OFFSET 
      LDB A,I 
      SSB 
      JMP DOWN1 
      LDA D2044     PRINT NO MESSAGES WAITING ERROR 
      STA JERR
      JMP ERROR 
DOWN1 ADA DM4       MAIL IS WAITING, GET MESSAGE
      LDB A,I        FILE NAME
      STB NAME      STORE NAME IN THREE WORD ARRAY
      INA 
      LDB A,I 
      STB NAME+1
      INA 
      LDB A,I 
      STB NAME+2    PUT 3RD CHAR. AWAY
* 
*     OPEN MESSAGE FILE 
* 
      JSB OPEN      OPEN USER MESSAGE FILE
      DEF RTN13 
      DEF O.BUF     MESSAGE FILE DCB
      DEF JERR
      DEF NAME
      DEF IOPTN 
      DEF SECU
      DEF LUNO. 
RTN13 EQU * 
* 
      LDA JERR
      CPA DM6 
      JMP RMOV
      SSA 
      JMP ERR2
* 
*     OPEN OR CREATE LIST FILE
* 
      JSB OPENF     OPEN LIST FILE
      DEF RTN43 
      DEF UDCB      LIST FILE DCB 
      DEF JERR      ERROR RETURN WORD 
      DEF INAM      NAMR OF LIST FILE OR DEVICE 
      DEF ZERO      EXCLUSIVE OPEN
      DEF N.OPL 
      DEF N.OPL+1 
RTN43 EQU * 
* 
      LDA JERR      CHECK FOR OPEN ERROR
      SSA,RSS 
      JMP LAB15 
      CPA DM6 
      RSS           IF NOT FOUND, CREATE IT 
      JMP ERROR     ELSE REAL ERROR 
      LDA N.OPL+3   GET LIST FILE SIZE
      SZA,RSS       SPECIFIED?
      LDA DM1       USE -1
      STA N.OPL+3 
      LDA N.OPL+2   GET LIST FILE TYPE
      SZA,RSS       SPECIFIED?
      LDA D4        USE TYPE 4
      STA N.OPL+2 
      JSB CREAT     CREAT USER'S LIST FILE
      DEF RTN32 
      DEF UDCB      USER'S FILE DCB 
      DEF JERR
      DEF INAM      FILE NAME 
      DEF N.OPL+3 
      DEF N.OPL+2   TYPE
      DEF N.OPL     SECURITY CODE 
      DEF N.OPL+1   CRN 
RTN32 EQU * 
* 
      LDA JERR
      SSA 
      JMP ERROR     ANY OTHER TYPE OF ERROR 
* 
*     TRANSFER MESSAGE FILE TO USER'S FILE
* 
LAB15 JSB LOCF      GET LU # OF LIST DEVICE 
      DEF RTN19 
      DEF UDCB      LIST FILE DCB 
      DEF JERR      ERROR RETURN WORD 
      DEF TEMP      DUMMY 
      DEF TEMP      DUMMY 
      DEF TEMP      DUMMY 
      DEF TEMP      DUMMY 
      DEF LU        LU # RETURNED HERE
      DEF TYPE      FILE TYPE 
RTN19 EQU * 
* 
      LDA TYPE      GET FILE TYPE 
      SZA           TYPE 0? 
      JMP LAB18     NO, SO SET LP FLAG TO 0 
* 
      JSB XLUEX     EXTENDED LU EXEC CALL 
      DEF *+4 
      DEF D13       DEVICE STATUS REQUEST 
      DEF LU        LU # - CONTROL WORD 
      DEF IEQT5     STATUS RETURN WORD
* 
      LDA IEQT5     GET STATUS WORD 
      AND M3740     CHECK FOR LINE PRINTER
      CMA 
      ADA M5000 
LAB18 CLB           SET LINE PRINTER FLAG TO 0
      SSA           IF POSITIVE, NOT LINE PRINTER 
      INB           LINE PRINTER, PAD BLANK ON WRITE
      STB LU        SAVE LINE PRINTER FLAG
* 
LAB19 JSB READF 
      DEF RTN20 
      DEF O.BUF     MESSAGE FILE DCB
      DEF KERR      ERROR RETURN WORD 
      DEF UBUF      BUFFER
      DEF D128
      DEF LEN       NUMBER OF WORDS READ
RTN20 EQU * 
* 
      LDA LEN       NUMBER OF WORDS READ
      CPA DM1       END OF FILE?
      JMP LAB16     YES, CLOSE MESSAGE FILE 
* 
      LDA KERR
      SSA           ERROR OR END OF FILE? 
      JMP LAB16     YES, CLOSE MESSAGE FILE 
* 
      LDA LU        GET LINE PRINTER FLAG 
      STA B 
      ADA LEN       BUMP LENGTH BY 1 IF LINE PRINTER
      STA LEN       SAVE WORDS TO BE WRITTEN
      CMB,INB 
      ADB ADBUF     SET WRITE BUFFER TO IBUF-1 IF LP
      STB TEMP
* 
      JSB WRITF     NO WRITE FROM MESSAGE FILE
      DEF RTN21 
      DEF UDCB      USER MESSAGE FILE 
      DEF KERR
      DEF TEMP,I    BUFFER TO BE WRITTEN (UBUF-1 IF LP) 
      DEF LEN       NUMBER OF WORDS TO BE WRITTEN 
RTN21 EQU * 
* 
      LDA KERR      CHECK FOR WRITE ERROR 
      SZA,RSS 
      JMP LAB19     READ NEXT RECORD
* 
LAB16 JSB CLOSE     CLOSE MESSAGE FILE
      DEF RTN75 
      DEF O.BUF 
      DEF JERR
RTN75 EQU * 
* 
      LDA KERR
      CPA DM12      END OF FILE?
      JMP CLERR     YES 
      SZA           CHECK FOR READ ERROR
      STA RDERR     READ ERROR
CLERR LDA JERR
      SZA 
      JMP ERR2
* 
      STA ITRUN     INITIALIZE TRUNCATION WORD
      LDA IPURG,I   GET PURGE REQUEST 
      CPA D1        IF 1, THEN
      RSS           PURGE THE MESSAGE FILE
      JMP LAB66     DON'T PURGE MESSAGE FILE
* 
      LDA OVRD.     GET SESSION OVERRIDE FLAG 
      STA TEMP      SAVE IT'S CURRENT VALUE 
      IOR M2000     SET TO ALLOW WRITE ON SYS DISC
      STA OVRD. 
      JSB PURGE     PURGE USER'S MESSAGE FILE 
      DEF RTN65 
      DEF O.BUF     MESSAGE FILE DCB
      DEF JERR      ERROR RETURN WORD 
      DEF NAME      NAME OF MESSAGE FILE
      DEF SECU
RTN65 EQU * 
      LDA TEMP      RESET OVERRIDE FLAG 
      STA OVRD. 
      JMP RMOV2 
* 
*     REMOVE MAIL WAITING BIT 
* 
RMOV  LDA IPURG,I   GET PURGE REQUEST 
      CPA D1        IF 1, THEN REMOVE MSG WAITING BIT 
      RSS 
      JMP ERROR     NOT 1, SO JUST REPORT MSG FILE NOT FOUND
      ISZ CLEAN 
RMOV2 JSB READF     READ IN USER ACCOUNT RECORD 
      DEF RTN34 
      DEF I.BUF     ACCOUNT FILE DCB
      DEF JERR      ERROR RETURN WORD 
      DEF IBUF
      DEF D128
      DEF LEN       NUMBER OF WORDS READ
      DEF USACT     USER ACCT FILE RECORD NUMBER
RTN34 EQU * 
* 
      LDB DFIBF     1ST WORD OF ACCOUNT ENTRY 
      ADB OFFST     OFFSET TO USER'S ACCT (0 OR 64) 
      ADB D20       OFFSET TO MAIL WAITING WORD 
      CLA           CLEAR MESSAGE WAITING BIT 
      STA B,I 
* 
      JSB POSNT     POSITION TO USER'S ACCOUNT RECORD 
      DEF RTN39 
      DEF I.BUF     ACCOUNT FILE DCB
      DEF JERR      ERROR RETURN WORD 
      DEF USACT     RECORD NUMBER OF USER'S ACCOUNT 
      DEF D1        FLAG TO POSNT 
RTN39 EQU * 
* 
      JSB WRITF     WRITE RECORD BACK IN ACCOUNT FILE 
      DEF RTN41 
      DEF I.BUF 
      DEF JERR
      DEF IBUF
      DEF D128
RTN41 EQU * 
* 
LAB66 JSB RNRQ
      DEF RTN42 
      DEF D4
      DEF RESNO 
      DEF ISTAT 
RTN42 EQU * 
      LDA CLEAN 
      SZA 
      JMP OPERR 
* 
*     CHECK TO SEE IF TRUNCATION IS NEEDED
* 
      LDA N.OPL+3   CHECK TO SEE IF SIZE WAS SPECIFIED
      CPA DM1       IF -1, CLOSE WITH TRUNCATE
      RSS 
      JMP LAB88 
* 
*  CALCULATE THE NUMBER OF BLOCKS TO TRUNCATE 
* 
      JSB LOCF      FIND POSITION OF EOF
      DEF RTN22 
      DEF UDCB
      DEF JERR
      DEF IREC      RECORD NUMBER 
      DEF IRB       NEXT BLOCK
      DEF IOFF      OFFSET WITHIN BLOCK 
      DEF JSEC      SECTOR
RTN22 EQU * 
* 
      LDA JSEC      GET NUMBER OF SECTORS 
      CLB 
      DIV D2        DIVIDE BY 2 (2 SECTORS/BLOCK) 
      LDB IRB       NUMBER OF BLOCKS
      CMB,INB 
      ADA B         SUBTRACT BLOCKS 
      ADA DM1       SUBTRACT 1
      STA ITRUN     NUMBER OF BLOCKS TO TRUNCATE
* 
      CLA           ERROR RETURN WORD 
      JMP ERR2
OPERR LDA DM6 
      RSS 
ERROR LDA JERR
ERR2  STA IERR,I
      SZA,RSS 
      JMP LAB88 
* 
      JSB RNRQ      CLEAR ACCT FILE RN LOCK 
      DEF RTN45 
      DEF D4        CLEAR RN REQUEST CODE 
      DEF RESNO     ACCT FILE RESOURCE NUMBER 
      DEF ISTAT     STATUS RETURN WORD
RTN45 EQU * 
* 
LAB88 JSB CLOSE     CLOSE USER'S FILE 
      DEF RTN23 
      DEF UDCB
      DEF JERR
      DEF ITRUN 
RTN23 EQU * 
* 
      JSB CLOSE     CLOSE MESSAGE FILE
      DEF RTN24 
      DEF O.BUF 
      DEF JERR
RTN24 EQU * 
* 
      JSB CLOSE     CLOSE ACCOUNT FILE
      DEF RTN25 
      DEF I.BUF 
RTN25 EQU * 
      LDA RDERR 
      SZA 
      STA IERR,I
* 
* 
      JMP ME.SB,I   RETURN
XEQT  EQU 1717B 
ACCT  ASC 3,+@CCT!
ADACT BSS 1 
ADBUF DEF UBUF
ADIBF DEF IBUFR 
ADINM DEF INAM
ADSCB BSS 1 
CLEAN BSS 1 
CTR   BSS 1 
DM12  DEC -12 
DM6   DEC -6
DM4   DEC -4
DM1   DEC -1
ZERO  DEC 0 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D8    DEC 8 
D13   DEC 13
D14   DEC 14
D20   DEC 20
D24   DEC 24
D25   DEC 25
D45   DEC 45
D56   DEC 56
D64   DEC 64
D128  DEC 128 
D2044 DEC 2044      NO MESSAGES WAITING ERROR (SEVERITY SET)
DIRNO BSS 1 
DFIBF DEF IBUF
DNUM  BSS 1 
IBUF  BSS 128 
IEQT5 BSS 1 
INAM  BSS 3 
IOFF  BSS 1 
IRB   BSS 1 
IREC  BSS 1 
ISTAT BSS 1 
IOPTN DEC 1 
ITRUN BSS 1 
JERR  BSS 1 
JSEC  BSS 1 
KERR  BSS 1 
LEN   BSS 1 
LU    BSS 2 
LUNO. BSS 1 
M2000 OCT 20000 
M3740 OCT 37400 
M5000 OCT 5000
M7777 OCT 77777 
NAME  BSS 3 
NOPL  BSS 2 
OFFST BSS 1 
RDERR BSS 1 
RESNO BSS 1 
SECU  DEC -31178
TEMP  BSS 1 
TYPE  BSS 1 
* 
*  UBUF0 MUST DIRECTLY PRECEDE UBUF 
* 
UBUF0 ASC 1,
UBUF  BSS 128 
UDCB  BSS 144 
USACT BSS 1 
USRID BSS 1 
      END