ASMB,R,L,C * NAME: CREAT * SOURCE: 92070-18040 * RELOC: 92070-16040 * PGMR: G.A.A. * MOD: M.L.K. * * *************************************************************** * * (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. * * *************************************************************** * * NAM CREAT,7 92070-1X040 REV.1941 790709 * HED CREAT ENT CREAT,ECREA EXT CLOSE,$OPEN,.ENTR,GTOPN EXT CLD.R,.P1,.P2,.P3,.P4,.P6,.P7,.P8,.P9 EXT NAM..,$DBLX,.R1,.R2,.R3,.R5 SUP * * * 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,JSIZ) * O R * IER = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZ) * * 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) * * JSIZ (OPTIONAL, FOR ECREA ONLY) FOR A SUCCESSFUL FILE * CREATION, THE FILE SIZE IS RETURNED IN THE DOUBLE * WORD AT JSIZ. * * SCHEDULE PARAMETERS FOR D.RTR * * P1. FUNCTION CODE (1) * P2. +CR\-LU * P3. NAME 1,2 * P4. 3,4 * P5. 5,6 * P6. TYPE * P7. FILE SIZE * P8. RECORD SIZE * P9. SEC CODE * SKP ECREA NOP DOUBLE WORD ENTRY CCA SET DOUBLE WORD FLAG LDB ECREA SET UP RETURN ADDRESS JMP SETUP GO FINISH SPC 5 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 SC STA LU STA TYPE STA IBLK STA SCFLG LDA DDMSZ STA FSIZ JMP DREAT+1 SPC 5 DCB NOP IERR NOP NAME NOP SIZE NOP TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO FSIZ NOP NOP SCFLG DEF ZERO SCRATCH FILE CREATE FLAG SPC 1 DREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF DCB LDA TYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER10 NO - ERROR EXIT * LDA DBLWD GET DBL FLAG SZA,RSS DOUBLE OR SINGLE? JMP SINGL SINGLE, SKIP TESTS DLD SIZE,I DID USER PASS -1 ? ADA B ADD A AND B TO CHECK FOR -1 PASSED CPA N2 RESULT EQUAL TO -2? JMP STBZ YES, JUST STORE THEN DLD SIZE,I NO, GET SIZE AGAIN TO JSB $DBLX CHECK RANGE JMP EXIT ERROR (A = ERROR CODE) STBZ STB DSIZE SAVE LO ORDER BITS LDA TYPE,I IS THIS TYPE CPA .2 TYPE 2 ? RSS YES, MUST CHECK SIZE JMP UPDAT NO ISZ SIZE POINT TO SECOND ISZ SIZE DOUBLE WORD OF PAIR DLD SIZE,I NOW GET SIZE JSB $DBLX CHECK RANGE JMP EXIT ERROR RETURN STB DSIZ2 SAVE SIZE UPDAT LDA ADSIZ POINT TO INTERNAL STA SIZE SIZE ARRAY * SINGL JSB CLOSE GO CLOSE THE DCB (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 GTOPN GET CURRENT OPEN FLAG DEF *+1 CPA SCFLG,I IS THE SCRATCH FLAG SET AND CORRECT? JMP SETNM YES, THEN SKIP NAME CHECK JSB NAM.. GO CHECK THE NAME DEF *+2 DEF NAME,I SZA IF OK SKIP JMP EXIT ELSE EXIT ERROR * SETNM LDA NAME,I GOOD NAME SO STA .P3 SET ISZ NAME UP DLD NAME,I SKELETON DIRECTORY DST .P4 ENTRY IN BUF LDA TYPE,I SZA TYPE MUST BE SSA >0 JMP ER16 NOT >0 ; ERR STA .P6 LDB SIZE,I GET THE SIZE SZB,RSS IF SIZE IS ZERO, JMP ER16 THEN ERROR SSB,RSS IF POSITIVE JMP POSTV GO CHECK SIZE CCB NEGATIVE, SET SIZE TO -1 FOR D.RTR JMP STRP7 GO STORE .P7 POSTV RBL DOUBLE SIZE TO PHYSICAL SECTORS SSB REQUEST > 32K JMP ER16 YES, ERROR STRP7 STB .P7 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 .P6 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 ADB N3 TYPE 3 OR GREATER SSB,RSS YES, THEN CLA CLEAR RECORD SIZE STA .P8 SET RECORD SIZE LDA SC,I SET STA .P9 SECURITY CODE CLA,INA SET STA .P1 FUNCTION CODE LDA LU,I SET STA .P2 THE LU/CR WORD JSB CLD.R GO CALL D.RTR * LDA .R1 GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA .R2 YES; SET UP STA DCB,I TO CALL LDB DCB $OPEN CLE,INB TO LDA .R3 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 .R5 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 LDA FLAGS SET WRITTEN ON FLAG IN DCB LDB DCB GET WRITE FLAG ADB .13 ADDRESS STA B,I SET WRITTEN ON FLAG ADB .3 STEP TO THE BUFFER CCA AND SET EOF STA B,I IN FIRST WORD OF BUFFER EXIT0 LDA .R1 NO; USE D.RTR RETURN FOR ERROR EXIT STA IERR,I SET SINGLE WORD ERROR CODE ISZ DBLWD TEST DBL FLAG JMP DREAT,I SINGLE WORD EXIT SSA ERROR? JMP DREAT,I YES, RETURN CLB SET B FOR NORMAL COMPLETION (HI BITS 0) SWP PUT HI BITS IN A, LO IN B DST FSIZ,I STORE FILE SIZE STA IERR,I STORE 0 IN ERROR CODE JMP DREAT,I DOUBLE WORD EXIT SPC 3 ER4 LDA N4 SET ERROR JMP EXIT CODE ER10 LDA N10 AND JMP EXIT EXIT ER16 LDA N16 GET THE ERROR CODE JMP EXIT TAKE EXIT SKP N16 DEC -16 N10 DEC -10 N11 DEC -11 N2 DEC -2 N3 OCT -3 N4 OCT -4 .1 OCT 1 .2 DEC 2 .3 OCT 3 .13 DEC 13 .128 DEC 128 FLAGS OCT 100001 IB AND WR FLAGS ZERO NOP \ THESE TWO ARE DUMMY ZERO FOR NOP / FOR DOUBLE WORD DZERO DEF ZERO DSIZE NOP \ DUMMY SIZE IS DSIZ2 NOP / TWO WORDS ADSIZ DEF DSIZE ADDRESS TO INTERNAL SIZE PARAMETER DBLWD NOP DOUBLE WORD FLAG DDMSZ DEF DUMSZ ADDRESS OF DUMMY SIZE DUMSZ BSS 2 DUMMY RETURN SIZE FOR ECREA * A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END