ASMB,R,L,C HED (FMP) CREAT: CREAT A FILE * NAME: CREAT * SOURCE: 92071-18040 * RELOC: 92071-16040 * PGMR: G.A.A. * MOD: M.L.K., E.D.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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 92071-1X040 REV.2041 800707 * ENT CREAT,ECREA * EXT CLOSE EXT $OPEN, GTOPN, NAM.., $DBLX EXT CLD.R, .P1, .P2, .P3, .P4, .P6, .P6B, .P7, .P9, .R1 EXT .ENTR, $SETP * EXT F.DCB, F.TYP, F.SIZ, F.ST1, F.FLG EXT F.BFP, F.ST2 SUP SKP * * DESCRIPTION * * CREAT IS THE FILE CREATION ROUTINE OF THE RTE-L/20 * FILE MANAGEMENT PACKAGE (FMP). * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE) * O R * IERR = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,ISECU,ICR,IDCBS,JSIZE) * * WHERE: * * IDCB IS A DATA CONTROL BLOCK (144-WORD ARRAY) * TO BE USED TO CREATE THE FILE. IF * ISIZE<0 THEN THE CREATED FILE IS ALSO * OPENED TO THIS DATA CONTROL BLOCK. * * IERR WILL BE THE RETURN ERROR CODE (ALSO RETURNED IN A). * FOR DISC FILES, ACTUAL FILE SIZE CREATED WILL BE * RETURNED AS A POSITIVE NUMBER. * * NAME IS THE NEW FILE'S NAME (3-WORD ARRAY). * 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 IS ADDITIONAL FILE CREATION PARAMETERS (ARRAY): * FOR DISC FILES (ITYPE>0), WORD 1 CONTAINS THE REQUESTED * FILE SIZE (IN BLOCKS). * FOR USER-DEFINED FIXED RECORD FILES (ITYPE=2), WORD 2 * CONTAINS THE REQUESTED RECORD LENGTH (IN WORDS). * FOR NON-DISC FILES (ITYPE=0), WORD 1 CONTAINS THE * REQUESTED DEVICE LU AND FUNCTION WORD, WORD 2 CONTAINS * THE EOF FUNCTION WORD, WORD 3 CONTAINS THE SPACING * FUNCTION WORD, WORD 4 CONTAINS THE READ/WRITE FUNCTION WORD. * * ITYPE IS THE FILE'S TYPE. * * ISECU IS THE FILE'S SECURITY CODE (OPTIONAL). * IF ISECU>0 THE FILE IS WRITE PROTECTED. * IF ISECU<0 THE FILE IS READ/WRITE PROTECTED. * IF ISECU=0 OR IS NOT CODED THE FILE IS PUBLIC. * * ICR IS THE FILE'S CARTRIDGE REFERENCE (OPTIONAL). * IF ICR<0 THEN THE DISC AT LOGICAL UNIT (-ICR). * IF ICR>0 THEN THE DISC WITH LABEL ICR. * IF ICR=0 OR NOT CODED, THE FIRST AVAILABLE * DISC WITH ENOUGH ROOM IS USED. * * IDCBS IS THE LENGTH OF THE PACKING BUFFER * AREA FOLLOWING DCB HEADER (OPTIONAL). * IF NOT CODED, A 128-WORD BUFFER IS ASSUMED. * THE BUFFER MUST EVENLY DIVIDE THE FILE SIZE, * HENCE, ONLY PART OF THE SPECIFIED BUFFER MAY BE USED. * THE SIZE USED WILL BE: * SIZE USED = FILE SIZE/N WHERE * N = (FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * JSIZE WILL BE THE ACTUAL SIZE (IN SECTORS, 32-BIT) OF * THE FILE CREATED (OPTIONAL, USED FOR ECREA ONLY) * * POSSIBLE ERRORS: * * >0 THE CREAT WAS SUCCESSFUL - SIZE 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 SKP * * ENTRY * ECREA NOP DOUBLE WORD ENTRY CCA SET DOUBLE WORD FLAG LDB ECREA SET UP RETURN ADDRESS JMP SETUP * CREAT NOP CLA SET FALSE FOR DBL FLAG LDB CREAT GET RETURN ADDRESS * SETUP STA DBLWD STORE DOUBLE FLAG STB DREAT STORE RETURN ADDRESS LDA DZERO STA ITYPE STA ISECU STA ICR STA IDCBS STA SCFLG LDA DDSIZ STA JSIZE JMP DREAT+1 * IDCB NOP IERR NOP NAME NOP ISIZE NOP ITYPE DEF ZERO ISECU DEF ZERO ICR DEF ZERO IDCBS DEF ZERO JSIZE DEF ZERO NOP PLACE HOLDER FOR SPECIAL CALL SCFLG DEF ZERO SCRATCH FILE CREATE FLAG * DREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF IDCB * LDA ITYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER10 NO - ERROR EXIT * LDA IDCB SET UP POINTERS INTO DCB LDB F.DCB JSB $SETP DEF .16 NOP SKP * * PROCESS REQUEST * JSB CLOSE CLOSE DEF *+2 FILE DEF IDCB,I IF OPEN * SZA SKIP IF NO ERRORS CPA N11 OR IF NOT OPEN RSS JMP EREX OTHERWISE, TAKE ERROR EXIT * JSB GTOPN GET CURRENT OPEN FLAG DEF *+1 * CPA SCFLG,I IF THE SCRATCH FLAG IS SET AND CORRECT, JMP NAMOK THEN SKIP NAME CHECK * JSB NAM.. GO CHECK THE NAME DEF *+2 DEF NAME,I * SZA IF OK SKIP JMP EREX ELSE EXIT ERROR * LDA ITYPE,I GET REQUESTED FILE TYPE SZA,RSS IF TYPE ZERO, JMP ER16 THEN TAKE ERROR EXIT SKP * * GET CREATION PARAMETERS (ISIZE) * NAMOK LDA ITYPE,I GET FILE TYPE SZA IF NOT TYPE ZERO, JMP CREA1 THEN CONTINUE * LDA DBLWD GET DOUBLE-WORD FLAG SZA,RSS IF SINGLE, JMP CREA2 THEN GET SINGLE WORD PARAMETERS * DLD ISIZE,I GET 32-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER ISZ ISIZE JSB $DBLX IF OUT OF 16-BIT RANGE JMP EREX THEN TAKE ERROR EXIT * STB DLU SAVE DEVICE LU * DLD ISIZE,I GET 32-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER ISZ ISIZE JSB $DBLX IF OUT OF 16-BIT RANGE JMP EREX THEN TAKE ERROR EXIT * STB EOFC SAVE EOF CODE JMP CREA1 * CREA2 LDB ISIZE,I GET 16-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER STB DLU SAVE DEVICE LU * LDB ISIZE,I GET 16-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER STB EOFC SAVE EOF CODE SKP * * GET MORE CREATION PARAMETERS (ISIZE) * CREA1 LDA DBLWD GET DOUBLE-WORD FLAG SZA,RSS IF SINGLE, JMP CREA3 THEN GET SINGLE WORD PARAMETERS * DLD ISIZE,I GET 32-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER ISZ ISIZE JSB $DBLX IF OUT OF 16-BIT RANGE JMP EREX THEN TAKE ERROR EXIT * STB FSIZE SAVE FILE SIZE OR SPACING CODE * LDA ITYPE,I GET FILE TYPE SZA IF NOT TYPE ZERO, CPA .2 AND NOT TYPE 2, RSS JMP CREA6 THEN DON'T CHECK RECORD LENGTH * DLD ISIZE,I GET 32-BIT PARAMETER JSB $DBLX IF OUT OF 16-BIT RANGE JMP EREX THEN TAKE ERROR EXIT * STB RECLN SAVE RECORD LENGTH OR READ/WRITE CODE JMP CREA6 AND CONTINUE * CREA3 LDB ISIZE,I GET 16-BIT PARAMETER ISZ ISIZE AND BUMP TO NEXT PARAMETER STB FSIZE SAVE FILE SIZE OR SPACING CODE * LDB ISIZE,I GET 16-BIT PARAMETER STB RECLN SAVE RECORD LENGTH OR READ/WRITE CODE SKP * * MODIFY CREATION PARAMETERS * CREA6 LDB ITYPE,I GET FILE TYPE SSB IF NEGATIVE, JMP ER16 THEN TAKE ERROR EXIT * SZB,RSS IF FILE TYPE ZERO, JMP CREA4 THEN CONTINUE * * CHECK LEGALITY OF FILE SIZE * LDA FSIZE GET THE REQUESTED SIZE SZA,RSS IF FILE SIZE ZERO, JMP ER16 THEN TAKE ERROR EXIT * SSA IF FILE SIZE NEGATIVE, JMP CRE60 THEN CONTINUE * RAL CONVERT TO SECTORS SSA IF SIGN BIT SET, JMP ER16 THEN TAKE ERROR EXIT * STA FSIZE SAVE FILE SIZE FOR D.RTR * * HANDLE RECORD LENGTH REQUEST * CRE60 CPB .1 IF FILE TYPE ONE, JMP CRE61 THEN DO TYPE 1 STUFF * CPB .2 IF FILE TYPE TWO, JMP CRE62 THEN DO TYPE 2 STUFF * CLA SET RECORD LENGTH TO ZERO JMP CRE66 * CRE61 LDA .128 SET RECORD LENGTH TO 128 WORDS JMP CRE66 * CRE62 LDA RECLN GET REQUESTED RECORD LENGTH SZA IF ZERO, SSA OR NEGATIVE, JMP ER4 THEN TAKE ERROR EXIT * ***** LDA FSIZE GET FILE SIZE ***** CLB CLEAR FOR DIVIDE ***** DIV RECLN CALCULATE NUMBER OF RECORDS/128 ***** CLB CLEAR FOR SHIFT ***** ASL 7 CALCULATE NUMBER OF RECORDS (MORE OR LESS) ***** SZB,RSS IF MORE THAN ***** SSA 32640 RECORDS, ***** JMP ER4 THEN TAKE ERROR EXIT * CRE66 STA RECLN SAVE RECORD LENGTH SKP * * SET UP D.RTR REQUEST * CREA4 CLA,INA GET FUNCTION CODE STA .P1 SAVE FOR D.RTR * LDA ICR,I GET CARTRIDGE IDENTIFIER STA .P2 SAVE FOR D.RTR * LDA NAME,I SAVE FOR D.RTR STA .P3 ISZ NAME DLD NAME,I DST .P4 * LDA ITYPE,I GET REQUESTED FILE TYPE STA .P6 SAVE FOR D.RTR * DLD DLU GET TWO PARAMETERS DST .P6B SAVE FOR D.RTR DLD FSIZE GET TWO MORE PARAMETERS DST .P7 SAVE FOR D.RTR * LDA ISECU,I GET SECURITY CODE STA .P9 SAVE FOR D.RTR * JSB CLD.R GO CALL D.RTR * LDA .R1 GET D.RTR COMPLETION SSA IF ERROR, JMP EREX THEN TAKE ERROR EXIT SKP * * SET UP USER DATA CONTROL BLOCK * LDA IDCBS,I GET REQUESTED PACKING BUFFER SIZE LDB ISECU,I GET REQUESTED SECURITY CODE JSB $OPEN SET UP DCB JMP EREX DISC ERROR - EXIT * LDA F.ST1,I GET FIRST STATUS WORD IOR .1 SET UPDATE-MODE BIT STA F.ST1,I AND SAVE AGAIN * LDA F.TYP,I GET FILE TYPE ADA N3 IF SEQUENTIAL ACCESS FILE, SSA THEN WRITE EOF JMP EXIT ELSE EXIT NORMALLY * LDA F.ST2,I GET SECOND STATUS WORD IOR .1 SET WRITTEN ON FLAG STA F.ST2,I SAVE STATUS WORD * CCA SET EOF IN LDB F.BFP,I FIRST WORD STA B,I OF BUFFER SKP * * EXIT * EXIT JSB GTOPN SET OPEN FLAG DEF *+1 INTO DCB STA F.FLG,I * LDB F.TYP,I NO ERROR INTENDED SZB,RSS IF FILE TYPE ZERO, CLA,RSS THEN RETURN ZERO LDA F.SIZ,I ELSE RETURN FILE SIZE JMP EREX * ER4 LDA N4 ILLEGAL DOUBLE WORD PARAMETER JMP EREX * ER10 LDA N10 NOT ENOUGH PARAMETERS JMP EREX * ER16 LDA N16 ILLEGAL TYPE OR SIZE PARAMETER * EREX STA IERR,I SET ERROR CODE ISZ DBLWD IF THIS WAS NOT DOUBLE WORD CALL, JMP DREAT,I THEN RETURN (CREAT EXIT) * CLA LDB F.SIZ,I GET ACTUAL FILE SIZE DST JSIZE,I SAVE 32-BITS FOR USER * LDA IERR,I GET ERROR CODE AGAIN JMP DREAT,I AND RETURN (ECREA EXIT) SKP * * STORAGE AREA * ZERO NOP 32-BIT ZERO NOP * N16 DEC -16 N10 DEC -10 N11 DEC -11 N4 DEC -4 N3 DEC -3 * .1 DEC 1 .2 DEC 2 .16 DEC 16 .128 DEC 128 * DZERO DEF ZERO DDSIZ DEF DUMSZ * DLU NOP - CREATION PARAMETER BUFFER EOFC NOP ! FSIZE NOP ! RECLN NOP - * DBLWD NOP DOUBLE WORD FLAG DUMSZ NOP DUMMY RETURN SIZE FOR ECREA NOP * A EQU 0 B EQU 1 * END EQU * * END