SPL,L,O,M ! NAME: CR.. ! SOURCE: 92067-18205 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (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. * ! *************************************************************** ! NAME CR..(8) "92067-16185 REV.2040 800731" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780414 TO CLOSE O.BUF AFTER GETTING DEFAULT ! LU DEFINED (RELEASE THE LOCK). (GLM) ! 2) 780516 TO HANDLE LOCK. ERROR RETURN PARAMETER, AND ! TO HANDLE CREA. ERROR RETURN ! 3) 780721 TO USE NEW D.RTR CALLING SEQUENCES ! 4) 790116 TO ZERO SIZE WORDS FOR TYPE 0 CREATE ! 5) 790127 TO ALLOW TYPE 0 FILES ANYWHERE ON ANY CARTRIDGE ! IN USER'S ADDRESSING SPACE ! 6) 790226 TO SET EOF CODE (AVOIDING LU LOCK IN OPEN.) ! 7) 800311 TO DISALLOW CREATE OF TYPE 0 FILE IF LU=DISC ! 8) 800731 TO PROPERLY CLOSE TYPE 0 FILE (SST #4887) ! ! THIS MODULE OF FMGR CREATES EMPTY FILES. ! IT ALSO CREATES TYPE 0 FILES. ! ! COMMANDS WHICH THIS ROUTINE HANDLES ARE: ! ! CR,NAMR ! WHERE ! NAMR IS A NAME REFERENCE ! WHICH INCLUDES ! SC SECURITY CODE ! CR CARTRIDGE ID ! TY TYPE ! SZ 1 SIZE (NO. OF BLOCKS) ! SZ 2 RECORD SIZE (ONLY IF TY=2) ! OR ! CR,NAMR,LU,RWOP,SPOP,EOFOP, SUBFUN OP ! WHERE : ! NAMR IS AS ABOVE EXCEPT ! TY=0 ! LU IS THE DEVICE LOGICAL UNIT ! RWOP IS THE READ WRITE OPTION ! I.E. "READ", "WRITE", "BOTH" ! SPOP IS THE SPACING OPTION ! I.E. " BSPACF", "FSPACE", "BOTH" ! EOF IS THE END OF FILE OPTION ! I.E. "EOF","LEADER","PAGE", ! NUMERIC SUB FUNCTION. ! SUBFUNOP IS THE READ/WRITE ! SUB FUNCTION ! (I.E. "BINARY","ASCII",NUMERIC ! SUBFUNCTION. ! DEFINE EXTERNALS ! LET CREA., \FMGR FILE CREATE ROUTINE EXEC, \RTE EXEC ROUTINE IER., \FMGR ERROR HANDLING ROUTINE NAM.., \FMP NAME CHECKING ROUTINE RMPAR \PARAMETER FETCH ROUTINE BE SUBROUTINE,EXTERNAL ! ASSEMBLE ["EXT .MVW"] ! LET .E.R., \FMGR ERROR WORD D., \ASCII "D.RTR" N.OPL, \FMGR SUBPARAMETER ARRAY O.BUF, \INTERNAL FMGR BUFFER PK.DR, \FILE DIRECTORY BUFFER S.CAP \9P - SESSION CAPABILITY LEVEL BE INTEGER,EXTERNAL ! LET CR.. BE SUBROUTINE ! ! ! DEFINE 16 WORD TYPE 0 NAME BLOCK ! LET NAM,NAM1,NAM2(2),LUC,\ EFT,SPLC,RW,SC(8) BE INTEGER ! ! DEFINE CONSTANTS ! LET READI BE CONSTANT (1) LET WRITI BE CONSTANT (2) LET XEQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET EOF BE CONSTANT (42517K) LET LE BE CONSTANT (46105K) LET PA BE CONSTANT (50101K) LET AS BE CONSTANT (40523K) LET BI BE CONSTANT (41111K) LET RE BE CONSTANT (51105K) LET WR BE CONSTANT (53522K) LET BO BE CONSTANT (41117K) LET BS BE CONSTANT (41123K) LET FS BE CONSTANT (43123K) LET STWD BE CONSTANT (100015K) ! CR..: SUBROUTINE(NO,LIS,ER) GLOBAL TY_@N.OPL+2 DCB4_[DCB2_[DCB1_[DCB_@O.BUF]+1]+1]+2 ! LIS21_[LIS20_[LIS17_[LIS16_[LIS13_[LIS9_[\ LIS5_[LIS1_@LIS+1]+4]+4]+4]+3]+1]+3]+1 ! FOR T_@NAM TO @NAM +15 DO $T_0 !CLEAR TYPE 0 NAME BLOCK IF $TY THEN [CREA.(O.BUF, $LIS1,N.OPL)?[\CREA. IF NOT TYPE 0 ER_-15;RETURN];IER.;RETURN] IF $LIS5 >20000K THEN GO TO ILLU !LU MUST BE NON-ASCII IF $LIS5<1 THEN GO TO ILLU !NEGATIVE LU ILLEGAL IFNOT $LIS9 THEN GO TO MISPM !RE,WR OR BO MUST BE GIVEN ! ! SET R/W CODE IN DIRECTORY ENTRY BUFFER ! IF $LIS9 = RE THEN RW_100000K IF $LIS9 = WR THEN RW_1 IF $LIS9 = BO THEN RW_100001K IFNOT RW THEN GO TO ILLPM !ERROR, NOT RE,WR OR BO ! ! SET SPACING CODE ! IFNOT $LIS13 THEN GO TO EOFCD !SKIP IF NO SPACING CODE IF $LIS13 = BS THEN SPLC_100000K IF $LIS13 = FS THEN SPLC_1 IF $LIS13 = BO THEN SPLC_100001K IFNOT SPLC THEN GOTO ILLPM !BAD SPACING CODE ! ! SET EOF CODE IN DIRECTORY ENTRY BUFFER (DEFAULT=FMGR DEFAULT) ! EOFCD:IF $LIS17 = EOF THEN EFT_100K IF $LIS17 = PA THEN EFT_1100K IF $LIS17 = LE THEN EFT_1000K IF $LIS16<3 THEN EFT_($LIS17 AND 37K)-<6 !IF NUMERIC,USE AS CTL IF $LIS16 THEN GO TO EOF3 CALL EXEC(STWD,$LIS5,EQT5,EQT4,BF) !STATUS REQUEST ON LU GO TO UNDEF !ILLEGAL OR UNDEFINED LU EFCOD_1100K !ASSUME TTY-PRINTER EQT5_EQT5 AND 37400K !GET DRIVER TYPE IF EQT5 > 13400K THEN [ \IF A DISC (30-33) IF EQT5 < 16000K THEN GOTO ILLU] !THEN ILLEGAL LU IF EQT5 > 7000K THEN \IF DRIVER TYPE > 16 GO TO EOF1 !USE EOF CODE OF 100K IF EQT5=2400K THEN [ \IF DVR05 AND IF [BF_BF AND 7]=1 THEN GO TO EOF1, \SUBCHANNEL 1 OR 2 ELSE [IF BF=2 THEN [ \I.E., CTU EOF EOF1: EFCOD_100K; GO TO EOF2]]] IF EQT5=1000K THEN EFCOD_1000K !IF PUNCH, USE LEADR FN EOF2: EFT_EFCOD OR ($LIS5 AND 77K) EOF3: IFNOT EFT THEN GO TO ILLPM ! ! SET SUB FUNCTION (DEFAULT 00=ASCII) ! IFNOT $LIS20 THEN GO TO SETUP !DEFAULT DATA TYPE TO ASCII IF $LIS20<3 THEN LUC_($LIS21 AND 37K)-<6 !IF NUMERIC, USE IT IF $LIS21 = BI THEN LUC_100K IF $LIS21=AS THEN GO TO SETUP IFNOT LUC THEN GO TO ILLPM !IF GIVEN AND NOT BI,AS OR NUMERIC ! SETUP: LUC_ LUC+[T_($ LIS5 AND 77K)] EFT_EFT OR T NAM.. ($LIS1) !CHECK FOR VALID FILE NAME IF .A. THEN GO TO ILNAM !ILLEGAL NAME? DIS_$(@N.OPL+1) !LU/CRN FROM SUBPARM ARRAY T1_@NAM FOR T_LIS1 TO LIS1+2 DO [$T1_$T;T1_T1+1] !MOVE NAME TO BUFFER SC(1)_N.OPL !MOVE THE SECURITY CODE ! SCHD: EXEC (23,D.,$XEQT,1,DIS,0,0,NAM,9) !D.RTR TO CREATE DIR ENTRY RMPAR(O.BUF) !GET RETURN WORDS TO O.BUF IF O.BUF THEN [ER_O.BUF;RETURN] !RETURN ON ERROR DISAD_@O.BUF+1 !DIREC ADDR FROM D.RTR EXEC(23,D.,$XEQT,0,$DISAD,$(DISAD+1),0,0.0,2) !CLOSE FILE RMPAR(O.BUF) ER_O.BUF !SET ERROR RETURN ! ILLU: DO[ ER_ 20 ; RETURN] MISPM:DO[ ER_ 55 ; RETURN] ILLPM:DO[ ER_ 56 ; RETURN] ILNAM:DO[ ER_-15 ; RETURN] UNDEF:IF S.CAP THEN ER_43, ELSE ER_52 !IF SESSION, ERR 43 RETURN ! END END END$