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-18365
* 
*     RELOCATABLE PART NUMBER : 92067-16361 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
* 
*     ACCRE - ROUTINE TO CREATE THE ACCOUNT FILE
* 
*     CALLING SEQUENCE:  CALL ACCRE(ISIZE,IERR) 
*                WHERE
*                        ISIZE = SIZE IN BLOCKS REQUIRED
*                        IERR  = ACERR RETURN WORD
* 
*     ACERRS:            FMP ACERR (CREAT)
* 
* 
      NAM ACCRE,7 92067-16361 REV.1940 790801 
      ENT ACCRE 
      EXT OVRD.,.ENTR,CREAT,PURGE 
      EXT $ACFL,ACOMD,$LIBR,$LIBX 
* 
A     EQU 0 
* 
NDCB  NOP 
NAME  NOP 
ISIZE NOP 
IERR  NOP 
* 
ACCRE NOP 
      JSB .ENTR     GET PARAMETERS
      DEF NDCB
* 
*                   SET FILE NAME 
* 
      LDA NAME,I    GET FIRST 2 CHARACTERS
      STA FNAME     THE REST ARE THE SAME 
* 
*     SET DISC LU IN $ACFL
* 
      LDA ACOMD+8 
      JSB $LIBR     GO PRIVILEGED TO DO IT
      NOP 
      XSA $ACFL+0 
      JSB $LIBX     AND COME OUT
      DEF *+1 
      DEF *+1 
* 
* 
*     GO PURGE FILE WITH OVERIDE SET
* 
      LDA OVRD.     SET OVERIDE BIT FOR OPEN
      IOR SIGN
      STA OVRD. 
* 
PURG  JSB PURGE     PURGE +@CCT!:-31178 
      DEF RTRN1 
      DEF NDCB,I
      DEF IERR,I
      DEF FNAME 
      DEF SC
* 
RTRN1 LDA IERR,I
      SSA,RSS       IF SUCCESSFUL TRY AGAIN 
      JMP PURG
* 
      CPA M6        IF MINUS SIX THEN WE CAN CREAT NEW FILE 
      RSS 
      JMP ACCRE,I   ELSE RETURN 
* 
      LDA ISIZE,I 
      SZA,RSS       IF SIZE "0" THIS WAS A PURGE
      JMP ACCRE,I   SO RETURN 
* 
*     CREAT FILE WITH OVERIDE BIT SET 
* 
      JSB CREAT     CREAT +@CCT!:-31178:($ACFL) 
      DEF RTRN2 
      DEF NDCB,I
      DEF IERR,I
      DEF FNAME 
      DEF ISIZE,I 
      DEF D1
      DEF SC
      DEF ACOMD+8 
      DEF D256
      DEF D0
      DEF D0
      DEF B707
* 
RTRN2 LDA OVRD.     CLEAR OVERIDE BIT 
      AND B7... 
      STA OVRD. 
* 
      JMP ACCRE,I   AND RETURN
* 
* 
D0    DEC 0 
D1    DEC 1 
D256  DEC 256 
M6    DEC -6
SC    DEC -31178
SIGN  OCT 100000
B7... OCT 77777 
B707  OCT 70707 
* 
FNAME ASC 3,+@CCT!
* 
* 
      END 
                                                                                                                                                                                                