ASMB,R,L,C,Q * NAME: CRETS * SOURCE: 92067-18502 * RELOC: 92067-16125 * 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 92067-16125 REV.1940 790726 * HED CRETS ENT CRETS EXT .ENTR, EXEC, D.R, OVRD. EXT $$CPU, ECREA, RMPAR 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 0 THROUGH 99 * * * 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-ENTRY ARRAY. EACH ENTRY IS A DOUBLE WORD. * THE FIRST ENTRY IS THE FILE SIZE IN 128-WORD * DOUBLE SECTORS (DOUBLE WORD). THE SECOND ENTRY * IS USED ONLY FOR TYPE 2 FILES AND IS THE RECORD * LENGTH (DOUBLE WORD). THE DEFAULT FILE SIZE IS * 24 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) * * JSIZE (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 * CLA CALCULATE WHAT THE ID SEGMENT NUMBER STA IDNUM IS FOR THIS PROGRAM. STEP LDB KEYWD THROUGH THE KEYWORD TABLE UNTIL KEY ISZ IDNUM AN ADDRESS IS FOUND THAT MATCHES XLA B,I XEQT - THE CURRENT PROGRAM EXECUTING. CPA XEQT MATCH? JMP CONVT FOUND IT SO GO CONTINUE INB STEP POINTER IN KEYWORD TABLE JMP KEY AND GO TRY THE NEXT ONE * CONVT LDA IDNUM GET ID SEGMENT 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 $$CPU GET CPU FLAG ALF,ALF AND PUT IN UPPER BYTE 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 ILNAM * 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 CCE SET UP D.RTR CALLING PARAMETERS LDA XEQT PUT ID SEGMENT ADDRESS WITH RAL,ERA BIT 15 SET STA IDNUM INTO 1ST PARAMETER * DLD NAME,I SET UP NAME WITH CCE SCRATCH FILE PURGE BIT RBL,ERB SET AND PASS IT TO DST PARAM D.RTR IN A STRING LDA NAME3,I PUT 3RD WORD INTO STA PARAM+2 STRING ALSO * JSB EXEC SCHEDULE D.RTR TO DO OPEN WITH DEF SCRTN SCRATCH FILE PURGE FLAG SET DEF .23 DEF D.R DEF IDNUM DEF OVRD. DEF LU,I DEF SC,I DEF ZERO DEF PARAM STRING DEF .3 3 WORDS LONG * SCRTN JSB RMPAR DEF *+2 DEF PARAM * LDA PARAM 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 * .3 DEC 3 .10 DEC 10 .23 DEC 23 B60 OCT 60 M38 DEC -38 M100 DEC -100 M101 DEC -101 M2 DEC -2 M10 DEC -10 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 ILNAM OCT 70707 XEQT EQU 1717B KEYWD EQU 1657B A EQU 0 B EQU 1 * * VARIBLES * IDNUM NOP NAME2 NOP NAME3 NOP * PARAM BSS 5 FOR D.RTR AND RMPAR * DUMSZ BSS 2 DUMMY RETURN SIZE * END EQU * END