ASMB,R,L,C * NAME: CREAT * SOURCE: 92064-18179 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (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 CREAT,7 92064-16058 REV.1650 761024 * HED CREAT ENT CREAT EXT CLOSE,$OPEN,.ENTR EXT $LIBR,$LIBX,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT NAM..,RMPAR EXT EXEC EXT D.R 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) * 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) * * * SCHEDULE PARAMETERS FOR D.RFP * * P1. FUNCTION CODE (1) * P2. +CR\-LU * P3. NAME 1,2 * P4. 3,4 * P5. 5,6 * (A) TYPE * (B) FILE SIZE * W27 RECORD SIZE * W28 SEC CODE * SKP CREAT NOP LDA DZERO STA SC STA LU STA TYPE STA IBLK LDA CREAT STA DREAT JMP DREAT+1 * DCB NOP IERR NOP NAME NOP SIZE NOP TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO 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 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 .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 BLS DOUBLE TO GET 64-WORD SECTORS SSB MUST BE >0 OR CCB SET TO -1 SZB,RSS IF ZERO JMP ER16 ERROR 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 CREA3 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 * * SAVE WDS 27 AND 28 OF IDSEG * THEN PASS PARMS 8&9 IN THEIR SPOT * * UPON RETURN FROM D.RFP RESTORE ORIGIONAL CONTENTS * * LDA XEQT FETCH IDSEG ADDRESS ADA .26 ADVANCE TO ADDRESS OF WD27 STA T27 SAVE IT DLD A,I FETCH 27&28 DST WD27 SAVE EM DLD .P8 FETCH PARMS 8&9 JSB ST267 SET THEM INTO IDSEG DLD .P6 SET A&B=PARMS 6&7 JSB CLD.R GO CALL D.RFP * * SPC 2 SPC 2 JSB RMPAR YES; DEF *+2 CALL RMPAR DEF .P1 TO GET RETURN CODES * * RESET 27&28 * DLD WD27 JSB ST267 * LDA .P1 GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA .P2 YES; SET UP STA DCB,I TO CALL LDB DCB $OPEN CLE,INB TO LDA .P3 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 .P5 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 CCA SET WRITTEN ON AND EOF FLAG IN DCB LDB DCB GET WRITE FLAG ADB .13 ADDRESS STA B,I SET WRITTEN ON FLAG ADB .3 STEP TO THE BUFFER AND SET EOF STA B,I IN FIRST WORD OF BUFFER EXIT0 LDA .P1 NO; USE D.RTR RETURN FOR ERROR EXIT STA IERR,I SET ERROR CODE JMP DREAT,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 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 DZERO DEF ZERO .P6 NOP .P7 NOP .P8 NOP .P9 NOP T27 NOP WD27 BSS 2 .26 DEC 26 * * ST267 NOP JSB $LIBR NOP DST T27,I JSB $LIBX DEF ST267 * * SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END