ASMB,R,L,C
*     NAME:   LSTDF 
*     SOURCE: 92070-18120 
*     RELOC:  92070-16120 
*     PGMR:   D.J.W.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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 LSTDF,7  92070-1X120  REV.1941  791011
* 
* 
*  LSTDF CREATES AND OPENS THE LIST FILE. NOTE THAT THE ERROR 
*  EXIT IS TO P+2, NOT P+1 AS USUAL.
* 
*  CALLING SEQUENCE:  JSB LSTDF 
* 
*  ON RETURN:         P+1:  LIST DEVICE DEFINED AND OPEN
*                     P+2:  ERROR OR NULL LIST, A-REG = ERROR CODE
* 
      ENT LSTDF,HEADR 
      EXT .MVW,AB.RT,CNAMR,CREAT,DRKEY,FCONT
      EXT FMPER,FOPEN,FTIME,I.ERR,IN.TR,IPBUF 
      EXT  LDCB,LNAMR,OPENF,PL.ST,SPACE,TMSTG 
* 
A     EQU 0 
B     EQU 1 
* 
LSTDF NOP 
      LDA IPBUF+3   WHAT TYPE NAMR IS THIS ?
      SZA,RSS 
      JMP RETRN     NULL, SO RETURN 
* 
      AND P3
      CPA P1        IS THIS AN LU ? 
      JMP OPENL     YES, GO OPEN THE FILE 
* 
*  NAMR IS A FILE 
* 
      LDA IPBUF     IS THE FIRST CHARACTER
      AND M7400 
      CPA QUOTE     A QUOTE "'" ? 
      JMP OPEN      YES, SO TRY OPENING THE FILE
* 
CRETF JSB CREAT     NO, JUST CREATE THE FILE
      DEF *+8 
      DEF LDCB+0    LIST DCB
      DEF I.ERR+0   ERROR PARAMETER 
AIPBF DEF IPBUF+0   LIST NAMR 
      DEF P12       FILE SIZE 
      DEF P4        FILE TYPE 
      DEF IPBUF+4   SECURITY CODE 
      DEF IPBUF+5   CARTRIDGE REFERENCE NUMBER
* 
ERR?  SSA           FMP ERROR ? 
      JMP ERROR 
GOOD  LDA AIPBF     NO ERROR, MOVE NEW LIST NAMR
      LDB ALNAM     INTO OFFICIAL LIST NAMR BUFFER
      JSB .MVW
      DEF P6
      NOP 
      JMP LSTDF,I   AND TAKE A GOOD RETURN
* 
*  ERROR ON ATTEMPTED CREAT OR OPEN 
* 
ERROR STA ERR       SET ASIDE THE ERROR CODE
      JSB FOPEN 
      DEF *+5 
ALNAM DEF LNAMR+0   NAMR UNCHANGED
      DEF LDCB      LIST DCB
      DEF IOPTN 
      DEF P144      DCB LENGTH
      JMP AB.RT     ERROR ON OPEN, WERE SUNK !!!
      LDA ERR       GOOD RETURN, NOW
      JSB FMPER     OUTPUT ORIGIONAL ERROR MESSAGE
      DEF IPBUF+0   ABOUT DESIRED LIST
* 
RETRN ISZ LSTDF     TAKE ERROR EXIT FROM LSTDF
      JMP LSTDF,I 
* 
ERR   BSS 1         ERROR CODE
P12   DEC 12
P3    DEC 3 
P144  DEC 144 
IOPTN DEC 0 
* 
*  TRY OPENING THE FILE 
* 
OPEN  JSB OPENF     OPEN THE LIST FILE
      DEF *+7 
      DEF LDCB      DCB ADDRESS 
      DEF I.ERR     ERROR PARM
      DEF IPBUF     NAMR BUFFER 
      DEF IOPTN     OPEN OPTION 
      DEF IPBUF+4   SECURITY CODE 
      DEF IPBUF+5   CRN 
      CPA N6        FILE NOT FOUND ?
      JMP CRETF     YES, CREATE THE FILE
      JMP ERR?      CHECK FOR AN ERROR
* 
*  LIST NAMR IS AN LU 
* 
OPENL JSB OPENF     OPEN THE (TYPE 0 ) FILE 
      DEF *+5 
      DEF LDCB      DCB ADDRESS 
      DEF I.ERR     ERROR PARM
      DEF IPBUF     LU TO BE OPENED 
      DEF P1        OPEN OPTION 
      SSA           FMP ERROR ? 
      JMP ERROR     YES 
* 
      LDA IN.TR     NO ERROR, CHECK FOR LIST = COMMAND
      SZA,RSS 
      JMP GOOD      COMMAND NOT INTERACTIVE, CANT BE EQUAL
      LDA IPBUF     ARE THEY THE SAME LU ?
      CLB,INB 
      CPA CNAMR 
      INB 
      STB IN.TR     YES, SET IN.TR = 2
      JMP GOOD
* 
QUOTE OCT 23400 
P6    DEC 6 
M7400 OCT 77400 
N6    DEC -6
P4    DEC 4 
P1    DEC 1 
      HED OUTPUT HEADER MESSAGE TO LIST DEVICE
* 
* 
*  HEADR OUTPUTS A HEADER MESSAGE TO THE LIST DEVICE
*  CONSISTING OF THE CURRENT TIME AND DATE STRING AS
*  RETURNED FROM SYSTEM SUBROUTINE  'FTIME'.   THE
*  STRING IS PLACED IN EXTERNAL BUFFER 'TMSTG'. 
* 
*  CALLING SEQUENCE:  JSB HEADR 
* 
*  ON RETURN:    P+1: ERROR RETURN
*                P+2: GOOD RETURN 
* 
* 
* 
HEADR NOP 
      JSB FTIME     CALCULATE THE CURRENT TIME AND DATE 
      DEF *+2 
ATMST DEF TMSTG+0   DESTINATION ADDRESS 
* 
      LDA PL.ST     ARE WE LISTING ?
      SZA,RSS 
      JMP NOLST     NO, SO DON'T NEED HEADER
      LDB ATIME     YES, SET TIME STRING INTO OUTPUT BUFFER 
      LDA ATMST     SAVE IN BUFFER IN THE MAIN
      JSB .MVW
      DEF P15       LENGTH OF TIME STRING BUFFER
      NOP 
* 
*     JSB FCONT     DO A TOP OF FORM REQUEST
*     DEF *+5 
*     DEF LDCB      LIST DCB
*     DEF I.ERR     ERROR PARAMETER 
*     DEF ICNWD     CONTROL WORD
*     DEF N2
      LDA MESH      GET HEADER MESSAGE ADDRESS
      LDB LMESS     AND LENGTH
      JSB DRKEY     OUTPUT TO THE LIST DEVICE 
* 
      SSA           FMP ERROR ? 
      JMP HEADR,I    YES, RETURN P+1
* 
      JSB SPACE     NO, SPACE UP A BLANK LINE 
      JSB SPACE 
NOLST ISZ HEADR     RETURN P+2
      JMP HEADR,I 
* 
ATIME DEF TIME
MESH  DEF *+1 
      ASC 15, 
TIME  ASC 15, 
LMESS DEC 60
ICNWD OCT 1100
P15   DEC 15
N2    DEC -2
      END 
                                                                                                                                                                                                                                                  