+5       *HONEYWELL* ALLOW ANS-COMPATIBLE LIBRARIES
*EQU ANS=1 IF PUBLIC LIBRARIES WILL SUPPORT ANS FORTRAN
*EQU ANS=0 IS PUBLIC LIBRARIES PREDATE ANS FORTRAN
         DEF      ANS
ANS      EQU      1
+22      *HONEYWELL* ALLOW ANS-COMPATIBLE LIBRARIES
         DO       ANS=1
         SREF     9INITIAL,8OPENFPT,7GETDCBK
         FIN
+80,80   *C. FRIES* ADD MODES FOR SHARED KEYED FILES (5=IN,7=INOUT)
*
*
MODES    DATA     X'04000108',X'02010404'  FILE MODES
*
+83      *HONEYWELL* ALLOW ANS-COMPATIBLE LIBRARIES
         DO       ANS=1
GETPUT   TEXTC    'GETPUT'
UNIT#    DATA     0
         FIN
+94      *MOT* RETURN MINOR CODE AS WELL FOR ERRSET
MINORFL  DATA      0              FLAG FOR RETURNING MINOR CODE
MINORCD  DATA      0              MINOR CODE STORAGE
+100,101
DCBS     DATA      0,0,0,0,0      ALLOW 19 DCBS
DCBADDRS RES       20             ALLOW 20 WORDS FOR DCB ADDRS
SVSIZE    RES            1
+115
SKPCNT     DATA         0
ST15     RES       1              SAVE LOC FOR REG 15
+125
SETDCBNG   FPT          X'1D',DCB:ADDR      FPT FOR SKIPPING
           GEN,2,30     3,16                IN THE REVERSE
           IND          COUNT               DIRECTION
           IND          SIZE
+146,146
         DATA     X'C74D1009'
+154,154
DEVICE   DATA     X'18B00'          DEVICE CODE (DP)
+157,159
GRANS    DATA     0                 RSTOR VALUES
         DATAB    1,0,8,8
FILENAME DO1      8
         DATA     0
+173     *MOT*    OPENF  CONSISTENCY CHECKING DATA AND ERROR MSGS
         PAGE
***************************************************************
*        OPENF CONSISTENCY CHECKING DATA                      *
***************************************************************
         BOUND    8
ORG:LIM  DATA     0,3
ACC:LIM  DATA     0,2
KEY:LIM  DATA     0,31
VOL:LIM  DATA     0,0
DEV:LIM  DATA     1,6
DEV:MODE DATA     X'00020102'
         DATA     X'01020200'
FID:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     FERR
         LI,10    #FERR
         CAL1,1   PRINT9
         B        EXITR
ORG:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     OERR
         LI,10    #OERR
         CAL1,1   PRINT9
         B        EXITR
ACC:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     AERR
         LI,10    #AERR
         CAL1,1   PRINT9
         B        EXITR
INSN:ERR LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     IERR
         LI,10    #IERR
         CAL1,1   PRINT9
         B        EXITR
KEY:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,10    #KERR
         CAL1,1   PRINT9
         B        EXITR
VOL:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     VERR
         LI,10    #VERR
         CAL1,1   PRINT9
         B        EXITR
DEV:ERR  LI,9     OOPS
         LI,10    #OOPS
         CAL1,1   PRINT9
         LI,9     DERR
         LI,10    #DERR
         CAL1,1   PRINT9
         B        EXITR
         REF      M:LL
PRINT9   GEN,8,24 17,M:LL
         GEN,4,28 3,0
         PZE      *9
         PZE      *10
OOPS     TEXT     '- - OPENF ERROR- - OPEN NOT ATTEMPTED.'
FERR     TEXT     'FILE NAME LARGER THAN SPACE IN DCB.'
OERR     TEXT     'ORGANIZATION VALUE SPECIFIED WAS NOT LEGAL.'
AERR     TEXT     'ACCESS VALUE SPECIFIED WAS NOT LEGAL.'
IERR     TEXT     'NO. OF INSNS SPECIFIED MORE THAN MAXIMUM ALLOWED.'
KERR     TEXT     'KEYM SPECIFIED IS LESS THAN 0 OR GREATER THAN 31.'
VERR     TEXT     'VOLUME ID SPECIFIED DOES NOT EXIST.'
DERR     TEXT   'DEVICE CODE GIVEN CONFLICTS WITH MODE OR OTHER PARAM.'
ENDTXT   EQU      $
#OOPS    EQU      (FERR-OOPS)*4
#FERR    EQU      (OERR-FERR)*4
#OERR    EQU      (AERR-OERR)*4
#AERR    EQU      (IERR-AERR)*4
#IERR    EQU      (KERR-IERR)*4
#KERR    EQU      (VERR-KERR)*4
#VERR    EQU      (DERR-VERR)*4
#DERR    EQU      (ENDTXT-DERR)*4
+240,241      *MOT* NO NEED TO ADD AND SUBTRACT TCB ADDR.
GOT:UNIT LW,ARG   DCBADDRS,MAX      GET DCB ADDRESS AND
         AND,ARG   =X'1FFFF'      SHOULD'NT BE -VE
+251     *HONEYWELL* ALLOW ANS-COMPATIBLE LIBRARIES
         DO       ANS=1
         STW,MAX  UNIT#
         FIN
+288,288                FIX BUG IN POINTER TO DCB ADDRESS LOGIC
           AI,ARG       8
+310,310
         CI,MAX    19             MAKE SURE IT FITS IN 5 WD TABLE
+314,315      *MOT* NO NEED TO ADD AND SUBTRACT TCB ADDR.
         STW,ARG  DCBADDRS,MAX      SAVE DCB ADDRESS
+350
         GET:ARG
         NOP
         LI,ADDR   NOKEYL         MUST LOOKAHEAD TO POSSIBLE KEYLENGTH ARG
         LW,COUNT  MAX            ESTABLISH COUNT IF NOT KEYL
         LI,INDX   0
         MTB,0     #ARGS          IS IT THERE?
         BEZ       CK1            BRIF NO KEYLENGTH ARG PRESENT
         LW,COUNT  NEXTARG
         LW,COUNT  *COUNT         GET KEYLENGTH ARG
         BLZ       $-1            ALLOW INDIRECT
         LW,COUNT  *COUNT         ARG IS NOW IN COUNT
         CW,COUNT  MAX            DONT ALLOW COUNT > MAX
         BLE       $+2
         LW,MAX    COUNT
CK1      LB,TEMP   *ARGADDR,INDX
         AI,INDX   1
         CW,INDX   COUNT
         BG        CNT:END        DONE..STORE COUNT AND RETURN
         B         *ADDR          DO THE SWITCH
NOKEYL   EQU       $
         CI,TEMP   0
         BE        CNT:END        IF NOT KEYL, SCAN FOR NULLS..
         CI,TEMP   X'40'          AND SPACES
         BE        CNT:END        TO TERMINATE KEY STRING
YESKEYL  STB,TEMP  *DESTIN,INDX
         B         CK1
*************************************************************************
+365   FIX TO READ FILE.ACCOUNT.PASSWORD FORMAT  PS 5/30/74
*
*
*************************************************************
* THE FOLLOWING CODE WAS ADDED TO READ FILE NAMES IN
* THE FORMAT FILE.ACCOUNT.PASSWORD AND THUS COMPATIBLE WITH
* CP-V CONVENTIONS
*************************************************************
*
*
CNTBYTE1 GET:ARG                    GET AN ARG
         RETURN
         LI,INDX  0                 CLEAR INDEX
         LB,TEMP  *ARGADDR,INDX     GET CHAR
         BEZ      CNT:END           WE ARE FINISHED, EXITRLOOP
         CI,TEMP  X'40'             BLANK?
         BE       CNT:END           YES, WE ARE FINISHED.  EXITRLOOP
         CI,TEMP   '.'            SECOND SUBFIELD ?
         BE        CNTBYTE2
         AI,INDX  1                 BUMP INDEX
         STB,TEMP *DESTIN,INDX      MOVE BYTE TO DESTINATION
         BL       CNTBYTE1+3        NO, DO MORE
         B         CNT:END        FINISHED  EXITR LOOP
CNTBYTE2 STB,INDX *DESTIN        PUT IN BYTE COUNT OF FILENAME
         LI,DESTIN ACCOUNT
         LI,MAX    0
         AI,INDX  1              BUMP INDEX
         LW,TEMP   =X'40404040'
         STW,TEMP  ACCOUNT
         STW,TEMP  ACCOUNT+1      BLANK FILL ACOUNT
CNTBYT21 LB,TEMP  *ARGADDR,INDX     GET CHAR
         BEZ      CNT:END+1
         CI,TEMP  X'40'             BLANK?
         BE       CNT:END+1         YES, WE ARE FINISHED.  EXITRLOOP
         CI,TEMP   '.'            PASSWORD  THERE?
         BE        CNTBYTE3       YES....
         CI,MAX    8              ACCOUNT NO MORE THAN 8 CHARS
         BE        CNT:END+1
         AI,INDX  1                 BUMP INDEX
         STB,TEMP *DESTIN,MAX       MOVE BYTE TO DESTINATION
         AI,MAX    1
         LW,TEMP   =X'00000200'
         OR,TEMP   ACCOUNT-1
         STW,TEMP  ACCOUNT-1      STORE CONTROL WORD IN FPT
         B         CNTBYT21
CNTBYTE3 LI,DESTIN PASSWORD         GET AN ARG
         LI,MAX    0
         AI,INDX  1              BUMP INDEX
         LW,TEMP   =X'40404040'
         STW,TEMP  PASSWORD
         STW,TEMP  PASSWORD+1     BLANK FILL PASSWORD
CNTBYT31 LB,TEMP  *ARGADDR,INDX     GET CHAR
         BEZ      CNT:END+1         WE ARE FINISHED, EXITRLOOP
         CI,TEMP  X'40'             BLANK?
         BE       CNT:END+1
         CI,MAX    8              PASSWORD NO MORE TAN 8 CHARS
         BE        CNT:END+1
         AI,INDX  1                 BUMP INDEX
         STB,TEMP *DESTIN,MAX       MOVE BYTE TO DESTINATION
         AI,MAX   1              BUMP COUNTER
         OR,TEMP   PASSWORD-1
         STW,TEMP  PASSWORD-1     STORE CONTROL WORD IN FPT
         B        CNTBYT31         NO, DO MORE
**********************************************************
*
+373,374
*
*                  KLUDGE TO MAKE BAD CODE GENERATED BY FORTRAN
*                  TO WORK
*
         STW,LINK  ST15           STORE AWAY REG 15
INDLOOP  LW,ARG    *ARG           GET ARG ADDRESS
         LW,LINK   =X'C0000000'
         CS,ARG    =X'80000000'   CHECK FOR INDIRECT ADDRESSING
         BE        INDLOOP        AND LOOP BACK IF INDIRECT
         LW,LINK   ST15           BRING REG 15 BACK.
+379,380                          DO NOT IGNORE BLANK ARGS
+399,399 *NAU* ALLOW 31 CHARACTER FILE NAMES
         LI,MAX   31                MAX FILENAME SIZE
+400,400 *MOT* MODS TO READ FILE.ACCOUNT.PASSWORD FORMAT 5/30/74
         CALL      CNTBYTE1       GET FILE NAME ETC..
+402,404
         BEZ      GET:MODE
         LI,INDX  3+4*22
         LB,INDX  *DCB:ADDR,INDX    RESERVED IN DCB FOR FID
         SLS,INDX 2                 MAKE IT NO. BYTES
         CB,INDX  FILENAME          COMPARE TO FID GIVEN
         BLE      FID:ERR           ERR OUT
         LI,TEMP  -2                CORRECT NO. WORDS
         AI,INDX  3
         SLS,INDX -2                AND STUFF IN FPT
         STB,INDX FILENAME,TEMP
*
GET:MODE EQU      $
+408     *C. FRIES* ADD CODE TO SET SHARED FLAGS
*
*
         LI,TEMP  0                 INITIALIZE SHARE FLAGS TO GO IN FPT
         CI,INDX  7                 SEE IF OPTION WAS FOR SHARED IN/OUT FILES
         BNE      $+3               BRANCH IF NOT
         B         $+4              CONTINUE AS USUAL
         CI,INDX  5                 SEE IF OPTION WZS FOR SHARED INPUT FILE
         BNE      $+2               BRANCH IF NOT
         LI,TEMP  X'300'            IF YES SET FLAGS TO GO IN FPT
*
+413,413 *C. FRIES* ADD CODE TO PUT SHARED FLAGS IN FPT
*
*
SET:MODE OR,INDX  TEMP              COMBINE MODE WITH SHARE FLAGS
         STH,INDX MODE              SAVE FOR FPT
*
+419,421 *MOT*    MAKE SURE PASSWORD GETS USED
GET:PASS EQU      $
         GET:ARG                    GET PASSOWRD ARGUMENT
         B        GET:ORG           NONE
         LI,9     1
         SLS,9    9
         STS,9    OPEN+1            SET BIT FOR PASSWORD
         LI,9     PASSWORD          DESTINATION
         BAL,15   MOVE:TWO+2        AND GO DO IT
+426     *MOT*    OPENF FOR RANDOM FILES AND LIMITS CHECKING
         LW,9     ORGAN
         CLM,9    ORG:LIM
         BCS,9    ORG:ERR           ARG OUT OF BOUNDS..DONT OPEN
         CI,9      3             IS IT A RANDOM FILE?
         BNE       $+3            NOT RANDOM FILE
         LI,9     1                 CHARGE RSTOR BIT
         SLS,9    12
         STS,9    OPEN+1
+430     *MOT*    CHECK LIMITS OF ACCESS CODE
         LW,9     ACCESS
         CLM,9    ACC:LIM
         BCS,9    ACC:ERR           OUT OF BOUND..DONT OPEN
+434,438 *MOT*    CHECK CONSISTENCY OF DEVICE CODE AGAINST MODE
         LI,MAX   3                 SET UP MAX
         B        GET:DEV1          DEFAULT
         LI,MAX   3
         CLM,ARG  DEV:LIM
         BCS,9    GET:DEV1
GET:DEV0 EQU      $
         LW,9     MODE
         AND,9    SEVEN
         LW,4     ARG
         BNE      DEV:ERR           ERR OUT IF BAD
         LB,9     FILENAME          IS THERE A FID SPECIFIED?
         BGZ      DEV:ERR           SHOULDN'T BE ONE..
         B        GET:DEV2
GET:DEV1 EQU      $
         LI,MAX   3
         CI,ARG   11
         BG       DEV:ERR
         BL       $+2
         LI,ARG   7                 DC AND DP SAME DOR NOW.
+447     *MOT* MAKE DEV CODE 7  OK LIKE 11
         CI,ARG      7
         BNE            $+2
         AI,ARG   4
+458,458 *MOT*    CONSISTENCY CHECKING
         B        INSN:ERR          TELL USER TOO MANY
+467     *MOT*    CONSISTENCY CHECKING
         LW,9     ARG
         CLM,9    KEY:LIM
         BCS,9    KEY:ERR           KEYM OUT OF BOUNDS..DO NOT OPEN
+470,470 *MOT*    CONSISTENCY CHECKING
         LI,ARG   0                 DEFAULT
         LW,9     ORGAN             GET ORGANIZATION
         CI,9     3                 IS IT RANDOM?
         BNE      GETVOL            NOPE..LOOK FOR VOL ID
         STW,ARG  GRANS             YUP..MUST BE RSTOR VALUE
         B        OPENIT            GO DO IT.
GETVOL   EQU      $
         LW,9     ARG
         CLM,9    VOL:LIM
         BCS,9    VOL:ERR
+473     *HONEYWELL* ALLOW ANS-COMPATIBLE LIBRARIES
         DO       ANS=1
         LI,MAX   9INITIAL
         BEZ      OPENIT2
         LI,MAX   OPEN
         STW,MAX  8OPENFPT
         LW,9     UNIT#
         BEZ      OPENIT2
         LI,5     GETPUT
         LH,TEMP  MODE
         STW,TEMP ACCESS+1
         BAL,6    7GETDCBK
         LI,6     0
         STW,6    UNIT#
         B        $+4
OPENIT2  EQU      $
         FIN
+474,474 *C. FRIES* ADD CODE TO PUT SHARED FLAGS IN FPT
*
         LH,TEMP  MODE              SET FILE MODE AND SHARE OPTIONS
         STW,TEMP ACCESS+1
*
+487   *C.FRIES. DONT CLOSE FILE ALREADY CLOSED*
         LH,TEMP  *DCB:ADDR         GET CLOSED BIT(FCD)
         CI,TEMP  X'20'             SEE IF ZERO
         BAZ      $+2               SKIP CLOSE IF ONE
+546
           CI,COUNT     0
           BL           SKIPRNG
+548
SKIPRNG    EQU          $
           STW,COUNT    SKPCNT
           LI,COUNT     0
           SW,COUNT     SKPCNT
           CAL1,1       SETDCBNG
           EXITR
+587,587
         LW,5     =X'1FFFF'
         LS,TEMP  ARGADDR           GET ADDR OF BUFFER
+595     FIX TO ACCEPT NEG NO. AS NUMBER OF BYTES
         MTW,0     SIZE
         BGEZ      GOT:KY2
         STW,SIZE  SVSIZE
         LI,SIZE   0
         SW,SIZE   SVSIZE
         B         $+2
GOT:KY2  EQU       $
+605,605 *HONEYWELL* ALLOW 5  ARGUMENTS IN ERRSET CALL
         SETUP    5,NOSCAN
+617     *MOT* ADD ANOTHER ARG TO ERRSET
         MTB,0     #ARGS          ANY MORE ARGS ?
         BEZ       ERRSET2        NO...DON'T RETURN MINOR CODE
         GET:ARG
         NOP
         LW,TEMP   ARGADDR
         STW,TEMP  MINORCD
         LI,TEMP   1
         STW,TEMP  MINORFL        SET MINOR CODE FLAG
         B         ERRSET3
ERRSET2  LI,TEMP   0              RESET MINOR CODE FLAG
         STW,TEMP  MINORFL
ERRSET3  EQU       $
+666,666 *MOT* USE INOUT OPTION FOR UPDATE FILES
         B         OPENIT         GO OPEN IN INOUT MODE
+705     *MOT* RETURN MINOR CODE ALSO FOR ERRSET
8    (
         MTW,0     MINORFL        NEED TO RETURN MINOR CODE?
         BEZ       SET:ERR2       NO.....
         LH,TEMP   SR3
         AND,TEMP  =X'000000FF'
         SLS,TEMP  -1
         STW,TEMP  *MINORCD       RETURN MINOR CODE
SET:ERR2 EQU       $
+END

