ASMB,R,L
*     NAME:   $BALB 
*     SOURCE: 92002-18006 
*     RELOC:  92002-16006 
*     PGMR:   A.M.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 $BALB 92002-16006 REV.2001 791022 
      END 
ASMB,R,L,C
      HED CREAT 
*     NAME:   CREAT 
*     SOURCE: 92002-18006 
*     RELOC:  92002-16006 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 CREAT,7 92002-16006 REV.1926 790501 
      ENT CREAT 
      EXT CLOSE,$OPEN,.ENTR 
      EXT NAM..,RMPAR 
      EXT EXEC
      EXT D.R 
      SUP 
* 
*  MODIFIED 781108 GLM TO NOT SET EOF READ BIT IN DCB 
*  MODIFIED 790501 GLM TO CHECK FOR REQUESTED SIZE > 16383 BLKS 
* 
* 
* 
*  CREAT     IS THE FILE CREATION MODULE OF THE REAL TIME 
*            FILE MANAGEMENT PACKAGE. 
* 
*            THE FORTRAN CALLING SEQUENCE IS: 
* 
*     CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK)
*        O R
*     IER = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK) 
* 
*        W H E R E: 
* 
*     IDCB     IS THE ADDRESS OF A 144-WORD ARRAY WHICH 
*              CREAT WILL USE AS A SCRATCH AREA.  IF
*              ISIZE<0 THEN THE CREATED FILE IS ALSO
*              OPENED TO THIS DATA CONTROL BLOCK. 
* 
*     IERR     IS THE ADDRESS TO WHICH THE ERROR CODE 
*              IS RETURNED.  THIS INFORMATION IS ALSO 
*              RETURNED IN THE A REGISTER.
* 
*              ERROR CODES ARE: 
* 
*     >0   THE CREAT WAS SUCCESSFUL - THE #SECTORS IS RETURNED
*     -1   THE DISC IS DOWN 
*     -2   DUPLICATE NAME 
*     -4   FILE TOO LONG
*     -6   CARTRIDGE NOT FOUND
*     -10  NOT ENOUGH PARAMETERS IN THE CALL
*     -13  DISC LOCKED
*     -14  DIRECTORY FULL 
*     -15  ILLEGAL NAME 
*     -16  ILLEGAL TYPE OR SIZE 
* 
* 
* 
*  NAME        IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME.
*              THE NAME MUST CONTAIN ONLY LEGAL ASCII 
*              CHARACTERS INCLUDING EMBEDDED BLANKS. COMMAS,
*              + SIGN, - SIGN ARE NOT ALLOWED.
*              IN ADDITION THE FIRST
*              CHARACTER MUST BE NON-NUMERIC AND NON-BLANK. 
* 
*  ISIZE       A TWO-WORD ARRAY.  WORD 1 IS THE SIZE IN 
*              124-WORD DOUBLE SECTORS.  WORD 2 IS USED 
*              ONLY FOR TYPE 2 FILES AND IS THE RECORD LENGTH.
* 
*  ITYPE       IS THE FILE TYPE--MUST BE >0.
* 
*  IS          (OPTIONAL); IS THE FILE'S SECURITY CODE. 
*              IF IS>0 THE FILE IS WRITE PROTECTED. 
*              IF IS<0 THE FILE IS OPEN PROTECTED.
*              IF IS=0 OR IS NOT CODED THE FILE IS PUBLIC.
* 
*  ILU         (OPTIONAL); DIRECTS THE CREAT TO:
*               IF ILU<0 THEN THE DISC AT LOGICAL UNIT (-ILU).
*               IF ILU>0 THEN THE DISC WITH LABEL ILU.
*               IF ILU=0 OR NOT CODED, THE FIRST AVAILABLE
*                 DISC WITH ENOUGH ROOM IS USED.
* 
*  IBLK        (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF 
*              IBLK WORDS.  (NORMALLY 128 IS USED.)  MUST BE A
*              MULTIPLE OF 128.  THE BUFFER MUST BE AN EVEN 
*              DIVISOR OF THE FILE SIZE SO ONLY PART OF 
*              THE SPECIFIED SIZE MAY BE USED.  THE USED SIZE IS: 
*              USED SIZE=FILE SIZE/N  WHERE 
*              N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0)
* 
      SKP 
DCB   NOP 
IERR  NOP 
NAME  NOP 
SIZE  NOP 
TYPE  DEF ZERO
SC    DEF ZERO
LU    DEF ZERO
IBLK  DEF ZERO
      SPC 1 
CREAT NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER THE PARAMETERS 
      DEF DCB 
      LDA TYPE      MAKE SURE THERE ARE 
      CPA DZERO     ENOUGH
      JMP ER10      NO - ERROR EXIT 
      JSB CLOSE     GO CLOSE THE DCR (IF OPEN)
      DEF *+2 
      DEF DCB,I 
      SZA           NO ERROR
      CPA N11       AND NOT OPEN ERROR - OK 
      RSS           SO SKIP IF THIS IS THE CASE 
      JMP EXIT      ELSE EXIT  SOME CLOSE ERROR 
      JSB NAM..     GO CHECK THE NAME 
      DEF *+2 
      DEF NAME,I
      SZA           IF OK SKIP
      JMP EXIT      ELSE EXIT ERROR 
      SPC 2 
      LDA NAME,I    GOOD NAME SO
      STA BUF        SET
      ISZ NAME        UP
      DLD NAME,I       SKELETON DIRECTORY 
      DST BUF+1         ENTRY IN BUF
      LDA TYPE,I
      SZA           TYPE MUST BE
      SSA           >0
      JMP ER16      NOT >0 ; ERR
      STA BUF+3 
      LDB SIZE,I    GET THE SIZE
*     *790501*
      CLE,ELB       DOUBLE TO GET 64-WORD SECTORS            790501 
      SEZ           IF REQUEST IS FOR THE REST OF THE DISC,  790501 
      JMP ALLD        GO SET SIZE PARM FOR D.RTR             790501 
* 
      SSB           IF > 16383 BLKS                          790501 
      JMP ER16         GIVE SIZE ERROR                       790501 
* 
      RSS                                                    790501 
ALLD  CCB           SET TO -1 
*     *790501*
      SZB,RSS       IF ZERO 
      JMP ER16      ERROR 
      STB BUF+6     SET 
      ISZ SIZE      STEP TO RECORD SIZE 
      CPA .2        IF NOT TYPE TWO 
      CLA,RSS       THEN
      JMP CREA4     SKIP SIZE TEST
      LSR 10        SHIFT TO A FOR DIVIDE 
      DIV SIZE,I    IF OVER FLOW THE RECORD SIZE TO SMALL 
      SOC           IF OK SKIP
      JMP ER4       ELSE ERROR FILE TOO LARGE 
CREA4 LDA SIZE,I
      LDB BUF+3     GET TYPE
      CPB .1        IF TYPE=1 
      LDA .128       SET SIZE TO 128
      CPB .2        IF TYPE TWO SIZE MUST BE GIVEN
      SSA,RSS       SIZE GIVEN? 
      RSS           YES; OR NOT TYPE TWO  SKIP
      JMP ER4       ELSE ERROR
CREA3 STA BUF+7     SET RECORD SIZE 
      LDA SC,I      SET 
      STA BUF+8      SECURITY CODE
      SPC 2 
      JSB EXEC      GET 
      DEF TRRQ       ONE
      DEF .4          TRACK 
      DEF .1           FROM 
      DEF TRACK         THE 
      DEF DLU            SYSTEM 
      DEF TMP 
TRRQ  JSB EXEC      WRITE 
      DEF WRRTN      THE
      DEF .2          DIRECTORY 
      DEF DLU          ENTRY
      DEF BUF           ON
      DEF .128           THE
      DEF TRACK           TRACK 
DZERO DEF ZERO             AT SECTOR ZERO 
WRRTN CCA           SET TO DISC ERROR CODE
      CPB .128      DISC ERROR
      RSS           NO; SKIP
      JMP EXIT      YES; EXIT 
      LDA TRACK     COMBINE 
      LSL 6          TRACK
      ADA DLU         AND LU
      STA TMP          FOR D.RTR
SCHLP JSB EXEC      SCHEDULE
      DEF SCHRT      D.RTR
      DEF .9          TO
      DEF D.R          CREAT
      DEF XEQT          THE 
      DEF TMP            FILE 
      DEF LU,I            PASSING 
      DEF TMP              THE
      DEF .1                TRACK 
SCHRT SZA           SCHEDULE OK 
      JMP SCHLP      NO; TRY AGAIN
      SPC 2 
      JSB RMPAR     YES;
      DEF *+2        CALL RMPAR 
      DEF BUF+4       TO GET RETURN CODES 
      JSB EXEC      RELEASE 
      DEF RTRTN      THE
      DEF .5          SYSTEM
      DEF .1           TRACK
      DEF TRACK 
      DEF DLU 
RTRTN LDA BUF+4     GET D.RTR COMPLETION
      SSA            CODE - OK
      JMP EXIT      NO; TAKE EXIT 
      LDA BUF+5      YES; SET UP
      STA DCB,I     TO CALL 
      LDB DCB        $OPEN
      CLE,INB         TO
      LDA BUF+6        OPEN 
      STA B,I           THE 
      LDA DCB            FILE 
      LDB SC,I
      STO           SET UP FOR A UPDATE OPEN
      JSB $OPEN     SET UP REST OF DCB
      DEF IBLK,I    ADDRESS OF BLOCK SIZE 
      DEF BUF+8     ADDRESS OF NO OF SECTORS/TRACK
      JMP EXIT      DISC ERROR - EXIT 
      LDA TYPE,I    GET TYPE
      ADA N3        IF 3 OR MORE
      SSA           SKIP TO WRITE EOF 
      JMP EXIT0     NOT RANDOM ACCESS FILE
*     *781108*
      LDA .1I       SET WRITTEN ON AND DATA IN DCB FLAG 
      LDB DCB       GET WRITE FLAG
      ADB .13       ADDRESS 
      STA B,I       SET WRITTEN ON FLAG 
      ADB .3        STEP TO THE BUFFER  AND SET EOF 
      CCA 
      STA B,I       IN FIRST WORD OF BUFFER 
*     *781108*
EXIT0 LDA BUF+4     NO; USE D.RTR RETURN FOR ERROR
EXIT  LDB DZERO      CODE 
      STB SC        RESTORE 
      STB LU         CALL WORDS 
      STB TYPE        FOR NEXT CALL 
      STB IBLK
      STA IERR,I    SET ERROR CODE
      JMP CREAT,I   AND EXIT
      SPC 3 
ER4   LDA N4        SET ERROR 
      JMP EXIT       CODE 
ER10  LDA N10         AND 
      JMP EXIT         EXIT 
      SPC 3 
ER16  LDA N16       GET THE ERROR CODE
      JMP EXIT      TAKE EXIT 
      SPC 3 
.1I   DEF 1,I 
TMP   NOP 
N16   DEC -16 
N10   DEC -10 
N11   DEC -11 
N3    OCT -3
N4    OCT -4
.1    OCT 1 
.2    DEC 2 
.3    OCT 3 
.4    DEC 4 
.9    DEC 9 
.5    DEC 5 
.13   DEC 13
.128  DEC 128 
DLU   NOP 
TRACK NOP 
ZERO  NOP 
BUF   BSS 9 
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
ASMB,R,L,C
      HED OPEN
*     NAME:   OPEN
*     SOURCE: 92002-18006 
*     RELOC:  92002-16006 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 OPEN,7 92002-16006 741205 
      ENT OPEN
      EXT EXEC,CLOSE,RMPAR,$OPEN
      EXT .ENTR 
      EXT D.R 
      SUP 
* 
*  OPEN    IS THE FILE OPEN ROUTINE OF THE REAL TIME
*          FILE MANAGEMENT PACKAGE
* 
*       THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) 
* 
*  W H E R E: 
* 
*     IDCB          IS A 144-WORD DATA CONTROL BLOCK (ARRAY)
*                   TO BE USED WITH ALL ACCESS TO THE FILE
*                   UNDER THIS OPEN.
* 
*     IERR          IS THE RETURN ERROR CODE (ALSO RETURNED IN A) 
* 
*     NAME          IS THE 6-CHARACTER (3 WORD) NAME ARRAY. 
* 
*     IOP           (OPTIONAL); IS THE OPEN OPTION FLAG WORD
*                    OPTIONS ARE: 
*                     BIT   MEANING IF SET
*                     0     NON-EXCLUSIVE OPEN
*                     1     UPDATE OPEN 
*                     2     FORCE TO TYPE 1 OPEN
*                     3     USE SUB FUNCTION IN BITS 6-11 
*                           IF TYPE 0.
* 
*     IS            (OPTIONAL); IS THE EXPECTED SECURITY CODE.
* 
*     ILU           (OPTIONAL); IS THE DISC SPECIFIED.
*                     IF ILU >0 THEN USE DISC LABELED ILU 
*                     IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU)
* 
*  IBLK        (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF 
*              IBLK WORDS.  (NORMALLY 128 IS USED.)  MUST BE A
*              MULTIPLE OF 128.  THE BUFFER MUST BE AN EVEN 
*              DIVISOR OF THE FILE SIZE SO ONLY PART OF 
*              THE SPECIFIED SIZE MAY BE USED.  THE USED SIZE IS: 
*              USED SIZE=FILE SIZE/N  WHERE 
*              N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0)
* 
*       OPEN ERRORS ARE AS FOLLOWS: 
* 
*     -1    DISC ERROR
*     -6    FILE NOT FOUND
*     -7    WRONG SECURITY CODE 
*     -8    FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR
*                IS CURRENTLY OPEN TO 7 OTHER PROGRAMS
*     -9    ATTEMPT TO OPEN TYPE 0 AS TYPE 1
*     -10   NOT ENOUGH PARAMETERS 
*     -13   DISC LOCKED 
* 
* 
      SKP 
DCB   NOP 
ERR   NOP 
NAME  DEF ZERO
OP    DEF ZERO
SC    DEF ZERO
LU    DEF ZERO
IBLK  DEF ZERO
      SPC 1 
OPEN  NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF DCB       TO LOCAL AREA 
      LDA N10 
      LDB NAME      DID WE GET
      CPB DZERO      ENOUGH PARAMETERS? 
      JMP EXIT        NO; ERROR - EXIT
      SPC 1 
      JSB CLOSE     CLOSE 
      DEF *+2        IF 
      DEF DCB,I      OPEN 
      SZA           SKIP IF NO ERRORS 
      CPA N11        OR IF NOT OPEN 
      CLE,RSS 
      JMP EXIT      ELSE TAKE ERR EXIT
      LDA NAME,I    GET NAME WORD1
      LDB OP,I       AND OPTION 
      ERB             EXCLUSIVE BIT TO E
      CME              INVERT AND 
      RAL,ERA           SET IN SIGN OF A
      STA NAME1     SET FOR CALL TO D.RTR 
      ISZ NAME      GET 
      DLD NAME,I     REST OF
      DST NAME1+1     NAME AND SET FOR D.RTR CALL 
      LDA XEQT      GET ID
      CCE            AND
      RAL,ERA         SET 
      STA ID           SIGN FOR D.RTR CALL
SCDRT JSB EXEC      SCHEDULE
      DEF SCRTN      D.RTR
      DEF .23         WITH WAIT 
      DEF D.R          TO OPEN
X     REP 4             THE FILE
      DEF ID+*-X
      DEF LU,I
SCRTN JSB RMPAR     YES; GET THE RETURN 
      DEF *+2        CODES
      DEF ID          TO LOCAL AREA 
      LDA ID        GET ERROR WORD
      SSA            IF ERROR 
      JMP EXIT        EXIT
      DLD ID+1      ELSE SET
      DST DCB,I      THE DCB FOR $OPEN
      CLO           SET O 
      LDA OP,I       TO 
      RAR,SLA,RAR     INDICATE
      STO              UPDATE OPTION
      ERA               AND E FOR TYPE 1 OVER-RIDE
      STA LU        SAVE FLAG 
      LDA DCB       GET DCB ADDRESS 
      LDB SC,I       AND SECURITY CODE
      JSB $OPEN       AND GO SET UP THE DCB 
      DEF IBLK,I    ADDRESS OF BLOCK SIZE 
      DEF ID+4      ADDRESS OF NO OF SECTORS PER TRACK
      JMP OPEN1     ERROR - CLOSE AND EXIT
      SSA           IF OPEN PROTECT 
      SSB            AND CODE MISMATCH THEN SKIP
      JMP OPEN2       ELSE GO EXIT - GOOD OPEN
      SPC 2 
      LDA N7        SET EXIT CODE 
OPEN1 STA ID        IN ID 
      JSB CLOSE     ILLEGAL OPEN SO CLOSE 
      DEF *+2        THE
      DEF DCB,I       FILE
OPEN2 LDA ID        SEND ERROR CODE 
      LDB LU        GET SUB FUNCTION FLAG 
      SLB           IF NOT SET
      SZA           OR NOT TYPE ZERO
      JMP EXIT      THEN EXIT 
      SPC 1 
      LDB DCB       CACULATE DCB SUB FUNCTION 
      ADB .3        ADDRESS 
      STB SC        SAVE IT 
      LDA OP,I      GET THE OPTIN SUB FUNCTION
      AND B3700     MASK IT OFF 
      STA B         AND SAVE IT 
      LDA SC,I      GET THE CURRENT WORD
      AND B77       SAVE THE LU 
      ADA B         ADD IN THE NEW SUB FUNCTION 
      STA SC,I      SET IT IN THE DCB 
      CLA           CLEAR A AND EXIT
      SPC 1 
EXIT  LDB DCB       IF NO ERRORS, 
      ADB .2        THEN REPLACE THE SIZE 
      SSA,RSS       WITH THE TYPE 
      LDA B,I       IF NO ERRORS
      LDB DZERO     RESET THE 
Y     REP 5         DEFAULT 
      STB NAME+*-Y    PARAMETERS
      STA ERR,I     SET THE ERROR CODE
      JMP OPEN,I     AND RETURN 
      SPC 2 
      SPC 3 
DZERO DEF ZERO
N10   DEC -10 
N11   DEC -11 
ID    NOP 
NAME1 BSS 4 
N7    DEC -7
ZERO  NOP 
.2    DEC 2 
.3    DEC 3 
B3700 OCT 3700
B77   OCT 77
.23   DEC 23
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 3 
END   EQU * 
      END 
ASMB,L
      HED PURGE 
*     NAME:   PURGE 
*     SOURCE: 92002-18006 
*     RELOC:  92002-16006 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 PURGE,7 92002-16006  740801 
      ENT PURGE 
      EXT OPEN,EXEC 
      EXT .ENTR,CLOSE 
* 
* 
      SUP 
* 
*  PURGE  IS THE FILE DELETION ROUTINE FOR THE RTE
*         FILE MANAGEMENT PACKAGE 
* 
*       THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL PURGE(IDCB,IERR,NAME,IS,ILU) 
* 
*  W H E R E: 
* 
*     IDCB          IS A 144-WORD DATA CONTROL BLOCK
*                   WHICH IS USED BY PURGE AS A 
*                   WORKING BUFFER.  IDCB IS FREE 
*                   FOR OTHER USE AFTER A PURGE.
* 
*     IERR          IS THE ERROR RETURN LOCATION. 
* 
*     NAME          IS THE NAME OF THE FILE TO BE PURGED. 
* 
*     IS            IS THE FILE'S SECURITY CODE.
* 
*     ILU           IS THE DISC THAT THE FILE IS ON.
*                     IF ILU >0 THEN ON DISC LABELED ILU
*                     IF ILU <0 THEN ON DISC AT LOGICAL UNIT (-ILU) 
* 
*       ERRORS RETURNED BY PURGE ARE: 
* 
*     CODE    REASON
*     0       NO ERRORS 
*     -1      DISC READ/WRITE ERROR 
*     -6      FILE (OR DISC) NOT FOUND
*     -7      ILLEGAL SECURITY CODE 
*     -8      FILE IS OPEN TO SOME OTHER PROGRAM
*     -10     NOT ENOUGH PARAMETERS 
*     -13     DISC LOCKED 
*     -16     ATTEMPT TO PURGE A TYPE 0 FILE
* 
* 
      SKP 
DCB   NOP 
IERR  NOP 
NAME  DEF ZERO
SC    DEF ZERO
LU    DEF ZERO
      SPC 1 
PURGE NOP           ENTRY POINT 
      JSB .ENTR     DO ENTRY ROUTINE
      DEF DCB 
      LDA N10       NOT ENOUGH PRAM 
      LDB NAME      ERROR 
      CPB DZERO     ? 
      JMP EXIT      YES-EXIT
      CLA           CLEAR THE TRUNCATE WORD 
      STA LNG       AND 
      SPC 1 
      JSB OPEN      NO; GO
      DEF OPRTN      OPEN 
      DEF DCB,I       EXCLUSIVELY 
      DEF IERR,I       TO 
      DEF NAME,I        CALLER
DZERO DEF ZERO
      DEF SC,I      PASS THE SECURITY CODE
      DEF LU,I       AND THE DISC ID
OPRTN SSA           OPEN ERROR? 
      JMP EXIT       YES; EXIT
      SZA,RSS         NO; TYPE ZERO 
      JMP EX16         YES - ILLEGAL PURGE
      SPC 1 
      LDA DCB       GET ADDRESS 
      ADA .7         OF 
      LDB A,I         SECURITY
      SSB,RSS           IF MISMATCH 
      JMP EX7            GO SET ERROR EXIT
      SPC 1 
      ADA N2        ADDRESS OF FILE LENGTH
      LDA A,I       GET FILE LENGTH 
      ARS           SET TO BLOCK LENGTH 
      STA LNG       SET FOR TRUNCATE CODE 
      SPC 1 
CLOS  JSB CLOSE     CLOSE THE FILE AND TRUNCATE TO ZERO 
      DEF *+4        (I.E. PURGE IT)
      DEF DCB,I       FILE
      DEF LU           DUMMY ERROR RETURN 
      DEF LNG           TRUNCATE WORD ADDRESS 
      LDB IERR,I    GET CURRENT ERROR CODE
      SSB           IF NONE SKIP
      LDA B         ELSE USE IT 
EXIT  STA IERR,I    SET THE ERROR CODE
      LDB DZERO        RESET
X     REP 3             THE 
      STB NAME+*-X       ENTRY
      JMP PURGE,I         AND EXIT
      SPC 2 
EX7   LDA .7        SET ERROR 
      CMA,INA,RSS    CODE AND SKIP
EX16  LDA N16 
      STA IERR,I    SET CODE IN USER AREA 
      JMP CLOS      GO CLOSE THE FILE 
      SPC 3 
N2    DEC -2
N10   DEC -10 
.7    DEC 7 
N16   DEC -16 
LNG   NOP 
ZERO  NOP 
D.RTR ASC 3,D.RTR 
      SPC 2 
XEQT  EQU 1717B 
A     EQU 0 
B     EQU 1 
      SPC 2 
END   EQU * 
      END 
ASMB,L
      HED NAMF
*     NAME:   NAMF
*     SOURCE: 92002-18006 
*     RELOC:  92002-16006 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 NAMF,7 92002-16006  771115
      EXT EXEC,.ENTR,CLOSE,NAM..,OPEN,RMPAR 
      ENT NAMF
* 
*     NAMF IS THE FILE NAME CHANGE MODULE OF THE
*     RTE FILE MANAGEMENT PACKADGE. 
* 
*     CALLING SEQUENCE: 
* 
*     CALL NAMF(IDCB,IERR,NAME,NNAME,IS,ILU)
* 
*     WHERE:
*         IDCB  IS A 144 WORD DATA CONTROL BLOCK
*               THIS AREA IS FREE AFTER THE CALL. 
* 
*         IERR  IS THE  ERROR RETURN LOCATION 
*               ERRORS  ARE RETURNED HERE AND IN
*               THE A REGISTER. 
*               DEFINED ERRORS ARE: 
* 
* 
*               0   NO ERROR
*              -1   DISC DOWN 
*              -2   DUPLICATE NAME
*              -6   CARTRIDGE OR FILE NOT FOUND 
*              -7   INVALID SECURITY CODE 
*              -8   FILE CURRENTLY OPEN 
*              -10  NOT ENOUGH PARAMETERS 
*              -13  THE REQUIRED DISC IS LOCKED 
*              -15  ILLEGAL NEW NAME
* 
*         NNAME THE NEW 6 CHARACTER FILE NAME 
* 
*         IS    OPTIONAL - THE FILE SECURITY CODE 
* 
*         ILU   OPTIONAL - THE FILES DISC ID. 
* 
*     PRECEEDING CONSTANTS
* 
N7    DEC -7
.7    DEC 7 
N10   DEC -10 
      SPC 3 
DCB   DEF ZERO      DEFINE
IERR  DEF ZERO       PARAMATER
NAME  DEF ZERO        ADDRESSES 
NNAME DEF ZERO
IS    DEF ZERO
ILU   DEF ZERO
      NOP 
      SPC 1 
NAMF  NOP           ENTRY POINT 
      JSB .ENTR     FETCH PARAM ADDRESSES 
      DEF DCB        TO LOCAL LIST
      SPC 1 
      LDA N10       LOAD FOR NOT ENOUGH PRAM REJECT 
      LDB NNAME     NEW NAME SUPPLIED?
      CPB DZERO 
      JMP EXIT      NO; GO EXIT 
      SPC 1 
      JSB NAM..     YES;NEW NAME
      DEF NAM.R     LEGAL 
      DEF NNAME,I    FOR A FILE NAME? 
NAM.R SZA 
      JMP EXIT      NO; EXIT
      JSB OPEN      CALL
      DEF OPRTN      TO 
      DEF DCB,I       OPEN
      DEF IERR,I       THE
      DEF NAME,I        FILE
      DEF ZERO           EXCLUSIVELY
      DEF IS,I            WITH
      DEF ILU,I            USER PRAMS 
OPRTN SSA           SUCESSFUL  OPEN?
      JMP EXIT      NO; EXIT
      LDA DCB       YES; CHECK
      ADA .7              THE 
      LDB A,I              SECURITY 
      LDA N7                CODE
      SSB,RSS                MATCH? 
      JMP CLOEX               NO; CLOSE AND EXIT
      JSB EXEC      GET 
      DEF EXR1       A
      DEF .4          SYSTEM
      DEF .1           TRACK
      DEF TRACK 
      DEF LU
      DEF DCB2
EXR1  JSB EXEC      WRITE 
      DEF EXR2       THE
      DEF .2          NEW 
      DEF LU           NAME 
      DEF NNAME,I       ON
      DEF .128           THE
      DEF TRACK           TRACK 
      DEF ZERO             SECTOR ZERO
EXR2  DLD DCB,I     GET DCB2 TO B 
      STB DCB2       AND SAVE IT
      LDA TRACK     FORM TRACK/LU 
      LSL 6          WORD 
      ADA LU          FOR 
      STA NAME         D.RTR CALL 
SCH   JSB EXEC      CALL
      DEF EXR3       D.RTR
      DEF .9          TO
      DEF D.RTR        CHANGE 
      DEF XEQT          THE 
      DEF NAME           FILE 
      DEF DCB,I           NAME
      DEF DCB2
      DEF .2
EXR3  SZA           SCHEDULE
      JMP SCH        CONFLICT- THEN TRY AGAIN 
      JSB RMPAR     CALL RMPAR TO GET 
      DEF *+2        RETURN PARAMETERS
      DEF NAME        TO LOCAL AREA.
      JSB EXEC      RETURN
      DEF EXR4       THE
      DEF .5          SYSTEM
      DEF .1           TRACK
      DEF TRACK 
      DEF LU
      SPC 1 
EXR4  RSS           SKIP ERROR ENTRY
CLOEX STA NAME       SAVE ERROR CODE
      JSB CLOSE     CLOSE 
      DEF CLOR1      THE
      DEF DCB,I       FILE
CLOR1 LDB NAME      GET ERROR CODE
      SZB            IF NONE SKIP 
      LDA B         ELSE USE IT 
EXIT  STA IERR,I    SET RETURN ERROR
      LDB DZERO     RESET 
X     REP 3          THE
      STB *-X+NNAME   ADDRESSES 
      JMP NAMF,I    EXIT TO USER
      SPC 3 
*     FOLLOWING CONSTANTS 
      SPC 1 
DCB2  NOP 
LU    NOP 
TRACK NOP 
ZERO  NOP 
DZERO DEF ZERO
      SPC 2 
*     TEMPS REFERENCED ONLY BY DEFS 
      SPC 1 
.1    DEC 1 
.2    DEC 2 
.4    DEC 4 
.5    DEC 5 
.9    DEC 9 
.128  DEC 128 
D.RTR ASC 3,D.RTR 
      SPC 2 
*     ASSEMBLY AIDS 
      SPC 1 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 1 
END   EQU *         PROG. LENGTH
      SPC 1 
      END 
                                                                                                                                                