SPL,L,O,M,C ! NAME: CR.. ! SOURCE: 92064-18157 ! RELOC: 92064-16055 ! 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. * ! *************************************************************** ! ! NAME CR..(7) " 92064-16055 REV.1650 761021" ! ! THIS MODULE OF THE RTE FMP ! ROUTINE F M G R CREATES EMPTY ! FILES, IT ALSO CREATS TYPE ! ZERO FILES. ! COMMANDS 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 ! (IN THIS CASE CR IS FORCED TO-2) ! 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.,NAM..,EXEC, \ RWNDF,WRITF, IER.,\ OPEN.,LOCK.,D.RIO,MVW,RMPAR,MSS.\ BE SUBROUTINE,EXTERNAL ! LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT LET FM.AB BE LABEL,EXTERNAL ! ! LET N.OPL,IDCB1,.E.R,.P1,.P2,.P3,.P4,.P5,\ D.SDR BE INTEGER,EXTERNAL ! DEFINE LOCAL SUBS. ! LET CR.. BE SUBROUTINE ! ! DEFINE TYPE ZERO NAME BLOCK ! LET NAM,NAM1,NAM2,LUC,\ EF,SP ,RW,SC(8) BE INTEGER ! ! DEFINE CONSTANTS ! LET XEQT BE CONSTANT (1717K) 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 READI BE CONSTANT (1) LET WRITI BE CONSTANT (2) LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! CR..: SUBROUTINE(NO,LIS, ER) GLOBAL TY_@N.OPL+2 ! DCB9_[DCB4_[R3_[R2_[DCB_@IDCB1]+1]+1]+2]+5 ! LIS21_[LIS20_[LIS17_[LIS16_[LIS13_[LIS9_[\ LIS5_[LIS1_@LIS+1]+4]+4]+4]+3]+1]+\ 3]+1 ! ADD_128 BLK,RW,SP, EF_0 !INITILIZE FLAGES ! FOR T_@NAM TO @NAM+14 DO $T_0 !CLEAR TYPE 0 NAME BLOCK IF $TY THEN [CREA.(IDCB1, $LIS1,N.OPL)?[\ ER_-15];RETURN] ! ! IF $LIS5 >20000K THEN GO TO ILLU IF $LIS5<1 THEN GO TO ILLU OPEN. (IDCB1,$LIS5,N.OPL,20000K)!SET DEFAULT EOF !AND INHIBIT LEADER IF PUNCH ! $DCB9_0 !ALSO PREVENT TRAILER ON CLOSE IFNOT $LIS9 THEN GO TO MISPM ! SET R/W CODE IF $LIS9 = RE THEN RW_100000K IF $LIS9 = WR THEN RW_1 IF $LIS9 = BO THEN RW_100001K IFNOT RW THEN GO TO ILLPM ! SET SPACING CODE IFNOT $LIS13 THEN GO TO EOFCD IF $LIS13= BS THEN SP_100000K IF $LIS13 = FS THEN SP_1 IF $LIS13=BO THEN SP_100001K IFNOT SP THEN GOTO ILLPM !BAD SP COMMAND ! SET EOF CODE (DEFAULT -FMGR DEFAULT) ! EOFCD:IF $LIS17=EOF THEN EF_100K IF $LIS17=PA THEN EF_1100K IF $LIS17=LE THEN EF_1000K IF $LIS16<3 THEN EF_($LIS17 AND 37K)-<6 IFNOT $LIS16 THEN EF_$DCB4 IFNOT EF THEN GO TO ILLPM ! ! SET SUB FUNCTION (DEFAULT 00=ASCII ! IFNOT $LIS20 THEN GO TO SETUP IF $LIS20<3 THEN LUC_($LIS21 AND 37K)-<6 IF $LIS21 = BI THEN LUC_100K IF $LIS21=AS THEN GO TO SETUP IFNOT LUC THEN GO TO ILLPM !IF GIVEN AND NOT SET ERROR ! SETUP: LUC_ LUC+[T_($ LIS5 AND 77K)] EF_EF OR T SC(1)_N.OPL !SET SECURITY CODE NAM.. ($LIS1) AREG_$0 IF AREG THEN GO TO ILNAM ! ! ! D.RIO(READI) !GET CURRENT COPY OF MASTER DIRECTORY IFNOT [LULK_-D.SDR] THEN \ !IF NOTHING MOUNTED [ER_-6;RETURN] !GIVE ERROR AND EXIT ! ! LOCK.(LULK,3)?[RETURN] ! LOCK THE DISC ! ! ! .P1_1 !SET FUNCTION CODE .P2_LULK !SET THE NEG DISK LU .P3_$LIS1 !SET 1ST 2 CHAR OF NAME .P4_$(LIS1+1) !NEXT TWO .P5_$(LIS1+2) !LAST TWO ! ASSEMBLE "CLA SET TYPE=0" ASSEMBLE "CLB SET SIZE=0" ! ! ! CLD.R !CALL D.RFP TO ASSIGN A DIR ENT ! RMPAR(IDCB1) !FETCH RETURN PARMS IF [ER_IDCB1] THEN RETURN !EXIT IF ERROR TR_(($R2 AND 177700K) -> 6) !ISOLATE TRACK SECT_ $R3 AND 377K ! SECTOR AND OFFSET_ (($R3 AND 177400K)->8) !OFFSET OF DIR ENTRY ! ! EXEC(READI,D.SDR,IDCB1,128,TR,SECT) !READ THE BLOCK IF $B # 128 THEN [MSS.(1, D.SDR);GOTO FM.AB] ! ! ! OFFSET_@IDCB1+OFFSET+4 !SET ADDRESS OF LU WORD MVW(@LUC, OFFSET,12) EXEC(WRITI,D.SDR,IDCB1,128,TR,SECT) !WRITE NEW BLOCK ! ! LOCK.(LULK,5) IDCB1_0 !CLEAR FIRST WORD FOR CLOSE RETURN ! ILLU: DO[ ER_ 20 ; RETURN] MISPM:DO[ ER_ 55 ; RETURN] ILLPM:DO[ ER_ 56 ; RETURN] ILNAM:DO[ ER_-15 ; RETURN] ! END END END$