SPL,L,O,M ! NAME: CR.. ! SOURCE: 92070-18016 ! RELOC: 92070-16016 ! PGMR: G.A.A. MOD. 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. * ! *************************************************************** ! ! NAME CR..(7) " 92070-1X016 REV.1941 790712" ! ! 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. ! ! EXTERNAL SUBROUTINES LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT LET CLOSE BE SUBROUTINE,EXTERNAL LET CREA. BE SUBROUTINE,EXTERNAL LET D.RIO BE SUBROUTINE,EXTERNAL LET EXEC BE SUBROUTINE,EXTERNAL LET LOCK. BE SUBROUTINE,EXTERNAL LET MSS. BE SUBROUTINE,EXTERNAL LET MVW BE SUBROUTINE,EXTERNAL LET NAM.. BE SUBROUTINE,EXTERNAL LET OPEN. BE SUBROUTINE,EXTERNAL LET RWNDF BE SUBROUTINE,EXTERNAL LET WRITF BE SUBROUTINE,EXTERNAL ! EXTERNAL VARIBLES LET .P1 BE INTEGER,EXTERNAL !D.RTR CALL PARAMETERS LET .P2 BE INTEGER,EXTERNAL LET .P3 BE INTEGER,EXTERNAL LET .P4 BE INTEGER,EXTERNAL LET .P5 BE INTEGER,EXTERNAL LET .P6 BE INTEGER,EXTERNAL LET .P7 BE INTEGER,EXTERNAL LET .R1 BE INTEGER,EXTERNAL !D.RTR RETURN PARAMETER LET .R2 BE INTEGER,EXTERNAL LET .R3 BE INTEGER,EXTERNAL LET D.SDR BE INTEGER,EXTERNAL LET O.BUF BE INTEGER,EXTERNAL LET N.OPL BE INTEGER,EXTERNAL ! INTERNAL SUBROUTINES LET CR.. BE SUBROUTINE ! INTERNAL VARIBLES LET NAM BE INTEGER !DEFINE TYPE 0 NAME BLOCK LET NAM1 BE INTEGER LET NAM2 BE INTEGER LET LUC BE INTEGER LET EF BE INTEGER LET SP BE INTEGER LET RW BE INTEGER LET SC(8) BE INTEGER ! INTERNAL CONSTANTS 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 LIS21_[LIS20_[LIS17_[LIS16_[LIS13_[LIS9_[ \ LIS5_[LIS1_@LIS+1]+4]+4]+4]+3]+1]+ \ 3]+1 ! ! CREATE FILE FOR TYPES 1 TO 32767 ! IF $TY \ THEN[ \ CREA.(O.BUF,$LIS1,N.OPL)?[ER_ -15];\CHECK FOR ERROR RETURN RETURN] ! AND RETURN ! ! CREATE TYPE 0 FILES ! DCB9_ [DCB4_ [DCB_ @O.BUF]+ 4]+ 5 ADD_128 BLK,RW,SP,EF_ 0 !INITIALIZE FLAGS ! FOR T_@NAM TO @NAM+14 DO $T_0 !CLEAR TYPE 0 NAME BLOCK ! IF $LIS5 >20000K THEN GO TO ILLU !IF LU IS ASCII, ILLEGAL IF $LIS5<1 THEN GO TO ILLU !IF LU NEGATIVE, ILLEGAL OPEN.(O.BUF,$LIS5,N.OPL,1) !GET DEFAULT EOF CLOSE(O.BUF) !NOW CLOSE LU ! ! ! SET R/W CODE ! IFNOT $LIS9 THEN GOTO MISPM !MISSING PARAMETER IF $LIS9 = RE THEN RW_100000K !SET READ CODE IF $LIS9 = WR THEN RW_1 !SET WRITE CODE IF $LIS9 = BO THEN RW_100001K !SET BOTH READ,WRITE CODES IFNOT RW THEN GOTO ILLPM !IF NO RW CODE, ILLEGAL ! ! SET SPACING CODE ! IFNOT $LIS13 THEN GOTO EOFCD !IF NO SP CODE, WORK ON EOF IF $LIS13= BS THEN SP_100000K !SET BACKSPACE CODE IF $LIS13= FS THEN SP_1 !SET FORWARD SPACE CODE IF $LIS13= BO THEN SP_100001K !SET BOTH CODES IFNOT SP THEN GOTO ILLPM !BAD SP CODE ! ! SET EOF CODE (DEFAULT -FMGR DEFAULT) ! EOFCD:IF $LIS17=EOF THEN EF_100K !EOF (MAG TAPE) IF $LIS17=PA THEN EF_1100K !PAGE EJECT IF $LIS17=LE THEN EF_1000K !PUNCH LEADER IF $LIS16<3 THEN EF_($LIS17 AND 37K)-<6 IFNOT $LIS16 THEN EF_$DCB4 !GET DEFAULT EOF IFNOT EF THEN GO TO ILLPM !ILLEGAL PARAMETER ! ! SET SUB FUNCTION (DEFAULT 00=ASCII) ! IFNOT $LIS20 THEN GOTO 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 ! IFNOT [LULK_ $(@N.OPL+1)] THEN[ \USE DISC INDICATED D.RIO(READI); \GET COPY OF MASTER DIR. IFNOT [LULK_-D.SDR] THEN[ \IF NOTHING MOUNTED ER_ -32; \ SET ERROR -32 RETURN]] ! 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 .P6,.P7_ 0 !SET TYPE AND SIZE TO 0 CLD.R !CALL D.RTR FOR A DIR ENT IF [ER_.R1] THEN GOTO EXIT !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 ! DSLU_ (.R2 AND 77K) + 7700K !CREATE DISC LU W/PROTECT EXEC(READI,DSLU,O.BUF,128,TR,SECT) !READ THE BLOCK IF $B # 128 THEN[ \ IF [T_LULK] < 0 THEN T_ -T; \ MSS.(2001,T+2000); \ GOTO EXIT] ! ! OFFSET_@O.BUF+OFFSET+4 !SET ADDRESS OF LU WORD MVW(@LUC, OFFSET,12) EXEC(WRITI,DSLU,O.BUF,128,TR,SECT) !WRITE NEW BLOCK ! EXIT: LOCK.(LULK,5) !UNLOCK THE DISC O.BUF_0 !CLEAR FIRST WORD FOR CLOSE RETURN ! ILLU: DO[ ER_ 20 ; RETURN] !ILLEGAL LU MISPM:DO[ ER_ 55 ; RETURN] !MISSING PARAMETER ILLPM:DO[ ER_ 56 ; RETURN] !ILLEGAL PARAMETER ILNAM:DO[ ER_-15 ; RETURN] !ILLEGAL NAME ! END END END$