ASMB,R,L,C * NAME: CRETS * SOURCE: 92070-18041 * RELOC: 92070-16041 * PGMR: 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 CRETS,7 92070-1X041 REV.1941 790709 * HED CRETS ENT CRETS EXT .ENTR,GTOPN,ECREA EXT CLD.R,.P1,.P2,.P3,.P4,.R1 SUP * * * CRETS IS THE SCRATCH FILE CREATION MODULE OF THE REAL TIME * FILE MANAGEMENT PACKAGE. * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZ) * O R * IER = CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZ) * * W H E R E: * * IDCB IS THE ADDRESS OF A 144-WORD ARRAY WHICH * CRETS 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 CRETS 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 * -38 ILLEGAL FILE NUMBER * * * NUM THE SCRATCH FILE NUMBER TO CREATE * * * NAME IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME * WHICH CRETS HAS CREATED. NOTE: THIS IS A RETURNED * PARAMETER. * * 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. * THE DEFAULT SIZE IS 30 BLOCKS. * * ITYPE IS THE FILE TYPE--MUST BE >0. THE DEFAULT IS TYPE 3. * * 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 CRETS 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) THE SIZE OF THE FILE CREATED IF * SUCCESSFUL. THIS IS A DOUBLE WORD VALUE * SKP CRETS NOP ENTRY POINT LDA CRETS MOVE THE STA DRETS RETURN ADDRESS LDA DZERO GET DUMMY 0 FOR DEFAULT STA NAME STA SC STA LU STA IBLK LDA DFLTS GET DEFAULT SIZE STA SIZE (=24 BLOCKS) LDA DFLTT GET DEFAULT TYPE STA TYPE (= 3) LDA DDMSZ GET POINTER TO DUMMY SIZE STA FSIZ STORE AT PARAMETER ADDRESS JMP DRETS+1 GO SET UP PARAMETERS SPC 3 DCB NOP IERR NOP NUM NOP NAME NOP SIZE NOP TYPE NOP SC NOP LU NOP IBLK NOP FSIZ NOP * DRETS NOP JSB .ENTR DEF DCB * LDA NAME TEST FOR ENOUGH CPA DZERO PARAMETERS JMP ER10 NOT ENOUGH! ERROR LDA NAME GET POINTER TO USER'S NAME BUFFER INA INCREMENT TO SECOND WORD STA NAME2 AND SAVE INA INCREMENT TO THIRD WORD STA NAME3 AND SAVE * JSB GTOPN GET CURRENT OPEN FLAG DEF *+1 STA OPFLG SAVE IT FOR LATER AND B377 ISOLATE THE ID NUMBER JSB CHAR CONVERT TO ASCII STB NAME2,I STORE TEMPORARILY IN LOW BITS JSB CHAR CONVERT THE NEXT CHAR OF ID # STB NAME,I STORE IN LOW BITS JSB CHAR CONVERT 100'S DIGIT BLF,BLF SHIFT TO HIGH BYTE ADB NAME,I ADD 10'S DIGIT STB NAME,I AND STORE IN USER'S BUFFER * LDB NAME2,I GET 1'S DIGIT LDA OPFLG AND RESTORE OPEN FLAG AND B3400 ISOLATE THE CPU# LSL 8 SHIFT BYTES INTO POSITION IN B ADB B60 ADD 60B TO CONVERT TO ASCII STB NAME2,I STORE IN USER'S BUFFER * LDA NUM,I TEST SCRATCH FILE NUMBER SSA TEST IF NEGATIVE JMP ER38 YES, ERROR 38 ADA M100 TEST FOR TOO LARGE SSA,RSS JMP ER38 YES, ERROR 38 * LDA NUM,I GET NUMBER AGAIN JSB CHAR CONVERT 1'S TO ASCII STB NAME3,I STORE IN USER'S BUFFER JSB CHAR CONVERT UPPER CHARACTER BLF,BLF SHIFT UP ADB NAME3,I ADD LOWER CHARACTER STB NAME3,I AND STORE IN USER'S BUFFER * * CALL ECREA * CREAT JSB ECREA CALL DOUBLE WORD CREATE DEF RTN DEF DCB,I DEF IERR,I DEF NAME,I DEF SIZE,I DEF TYPE,I DEF SC,I DEF LU,I DEF IBLK,I DEF FSIZ,I DZERO DEF ZERO DEF OPFLG * RTN SZA,RSS TEST FOR ERROR JMP EXIT NO ERROR, EXIT CPA M2 A -2 ERROR? JMP PURGE YES, DO SCRATCH FILE PURGE EXIT STA IERR,I NO, EXIT WITH CREAT ERROR CODE JMP DRETS,I * * * PURGE LDA .9 SET UP D.RTR CALLING PARAMETERS STA .P1 FOR SCRATCH FILE PURGE ON OPEN LDA LU,I STA .P2 SET UP LU LDA NAME,I GET FIRST TWO CHARACTERS STA .P3 STORE IN D.RTR CALLING PARAMETER DLD NAME2,I GET LAST FOUR CHARACTERS OF NAME IOR SIGN SET SCRATCH FILE PURGE BIT DST .P4 STORE IN .P4 AND .P5 JSB CLD.R CALL D.RTR * LDA .R1 GET ERROR PARAMETER CPA M101 IS IT -101 ? JMP EXIT YES, ERROR, CAN'T PURGE JMP CREAT NO, GO TRY TO CREATE THE FILE AGAIN * * ER38 LDA M38 SET ILLEGAL FILE NUMBER RETURN JMP EXIT * ER10 LDA M10 SET NOT ENOUGH PARAMETERS JMP EXIT * * CHARACTER CONVERSION SUBROUTINE * CHAR NOP CLB CLEAR UPPER BITS DIV .10 CONVERT TO DECIMAL CHARACTER ADB B60 CONVERT TO ASCII JMP CHAR,I RETURN SKP * * CONSTANTS * .9 DEC 9 .10 DEC 10 B60 OCT 60 B377 OCT 377 B3400 OCT 3400 M38 DEC -38 M100 DEC -100 M101 DEC -101 M2 DEC -2 M10 DEC -10 SIGN OCT 100000 ZERO NOP NOP TWO NECESSARY FOR DOUBLE WORD DFLTS DEF DSIZE DSIZE NOP DEFAULT SIZE DEC 24 = 24 BLOCKS DFLTT DEF DTYPE DTYPE DEC 3 = 3 DDMSZ DEF DUMSZ * * VARIBLES * NAME2 NOP NAME3 NOP OPFLG NOP DUMSZ BSS 2 DUMMY RETURN SIZE * END EQU * END