SPL,L,O,M ! NAME: SA.. ! SOURCE: 92067-18211 ! 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 SA..(8) "92067-16185 REV.2026 800304" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780427 TO MAKE IER. CALL ON RETURN FROM CREA. (BL) ! (IER. CALL REMOVED FROM CREA.) ! 2) 780920 TO USE EXTENDED FMP CALLS (ECREA,ELOCF,ECLOS) ! TO ACCEPT SIZE IN -MULTIPLE NUMBER OF BLOCKS ! 3) 800304 TO CORRECT TRUNCATION CALCULATION (SST #4732) ! ! THIS ROUTINE IS THE SAVE LS/LG ROUTINE FOR THE ! RTE FMGR PROGRAM. IT IS ENTERED BY ENTERING ! A COMMAND OF THE FORM: ! ! SA,LS/LG,NAMR !PRAM LOC 1 5 ! ! W H E R E: ! ! SA IS THE COMMAND NAME. ! ! LS/LG IS LS TO SAVE THE LS FILE, ! OR LG TO SAVE THE LOAD & GO FILE. ! ! NAMR IS TO BE THE NEW FILE'S NAME REFERENCE. ! ! ! THE FOLLOWING NAMR PARAMETERS ARE OPTIONAL: ! ! CR IS THE CARTRIDGE TO BE USED TO SAVE ! (ZERO IF NOT GIVEN). ! ! SC IS THE FILE'S SECURITY CODE ! (ZERO IF NOT GIVEN). ! ! TY IS THE FILE'S TYPE (4 FOR LS OR ! 5 FOR LG IF NOT GIVEN). ! ! SZ1 IS THE FILES SIZE ESTIMATE USED FOR LS FILES ONLY ! IF NOT GIVEN THE THE FILE IS ESTIMATED TO FILL ! LESS THAN HALF A TRACK. EXCESS THEN GENERATES AN EXTENT ! IF LESS THAN THE ESTIMATED SIZE IS USED THE ! EXCESS IS RETURNED TO THE SYSTEM ! ! CONSTANT DECLARATIONS ! LET XEQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET LGOTK BE CONSTANT (1765K) LET LGOC BE CONSTANT (1766K) LET LG BE CONSTANT (46107K) LET LS BE CONSTANT (46123K) ! ! DECLARE THE ERROR WORD LOCATION ! LET .E.R.,N.OPL BE INTEGER,EXTERNAL ! ! ARRAY DECLARATIONS ! LET O.BUF,I.BUF,BUF.,CUSE. BE INTEGER,EXTERNAL LET IRBN(2),IRCN(2),ITRUN(2),ISIZ(4),JSIZ(2), \ DW1(2),DW2(2),BLKMP(2) BE INTEGER ! INITIALIZE BLKMP TO 0,128 INITIALIZE DW1 TO 0,1 INITIALIZE DW2 TO 0,2 ! ! SUBROUTINE DECLARATIONS ! LET ECREA,OPEN.,IER.,\ WRITF,ELOCF,ECLOS,CLOS.,\ READ.,READF,RWNDF,\ MSS.,EXEC,CK.SM BE SUBROUTINE,EXTERNAL LET .DDI,.DMP,.DSB BE SUBROUTINE,EXTERNAL,DIRECT ! LET LSRD,LGRD,READR,\ GET BE SUBROUTINE ! LET IFBRK BE FUNCTION,EXTERNAL LET LG.S BE FUNCTION SA..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL LET NCAM,PLIST,MSNO BE INTEGER LIS5_[LIS1_@PLIST+1]+4 !SET LIST ADDRESSES SZ_[RS _[SC_@N.OPL+5]+2]+1 !SET OPTION LIST ADDRESSES ! IF NCAM<2 THEN[MSNO_50;RETURN] IF $LIS1=LG THEN GO TO SALG IF $LIS1#LS THEN [MSNO_56; RETURN] !NOT LS OR LG SO ABORT CUSE._0 !SHOW SEGMENT NOT IN CORE FOR NEXT TIME OPFL_101000K !SET PUNCH OPTION FLAG DO[T1_4;SIZE_$SECT2/4;RD_@LSRD]!SET UP DEFAULT SIZE SA02: IFNOT $SZ THEN $SZ_SIZE !SET DEFAULT SIZE IF NOT SUPPLIED IFNOT $RS THEN $RS _T1 !SET DEFAULT TYPE TYPE_$RS !SET TYPE FOR LATER CLOS.(O.BUF) IF $LIS5 < 64 THEN \OPEN IF NOT A FILE NAME [TYPE_0; \ OPEN.(O.BUF,$LIS5,$SC,OPFL); \ GO TO CONT1] IF $SZ < 0 THEN [ \IF FILE SIZE NEGATIVE, THEN IF $SZ = -1 THEN \IF SIZE = -1, THEN ISIZ(1),ISIZ(2)_ -1, \MAKE DOUBLE WORD, ELSE ELSE [.B._ -$SZ;.A._0; \MAKE POSITIVE AND CALL .DMP(BLKMP); \MULTIPLY BY BLK MULTIPLIER ISIZ(1)_.A.;ISIZ(2)_.B.]],\SAVE FOR ECREA ELSE [ISIZ(1)_0;ISIZ(2)_$SZ] !ELSE CONVERT TO DOUBLE WORD ISIZ(3)_0 ISIZ(4)_$(@N.OPL+9) !RECORD SIZE CALL ECREA(O.BUF,.E.R.,$LIS5,ISIZ,TYPE,$SC,$(SC+1),144,JSIZ) IER. CONT1:FIRST_1 LOOP: CALL $RD !READ A RECORD IF IFBRK() THEN [MSS.(0);GO TO ABOR] L_IL IFNOT IL THEN[IFNOT TYPE THEN L_-1] WRITF(O.BUF,.E.R.,BUF.,L) !WRITE IT IF .E.R.= -6 THEN[MSS.(.E.R.);GOTO ABOR]!PURGE FILE IER. ! ANY ERRORS? IF IL=>0 THEN GO TO LOOP ! IF NOT EOF CONTINUE ! IFNOT TYPE THEN RETURN ELOCF(O.BUF,.E.R.,IRCN,IRBN) !GET CURRENT POSITION IER. TRUN: .B._JSIZ(2);.A._JSIZ(1) !ACTUAL SIZE CALL .DDI(DW2) !CONVERT SECTORS TO BLKS CALL .DSB(IRBN) CALL .DSB(DW1) ITRUN(1)_.A.;ITRUN(2)_.B. ECLOS(O.BUF,.E.R.,ITRUN) !CLOSE & TRUNCATE IER. EXIT: RETURN !DONE RETURN SALG: TY_0 !SET LOAD & GO FLAG T1_5 !SET DEFAULT TYPE OPFL_101100K !SET THE OPTION FLAG SIZE _(([T_LG.S() ?[MSNO_58;RETURN]]+3)>-1)+T/5 !SIZE ESTIMATE RD_@LGRD !SET THE READ ROUTINE ADDRESS GO TO SA02 !GO DO IT END LSRD: SUBROUTINE READ.(2,BUF.,70,IL) RETURN END ! LGRD: SUBROUTINE BUF1_[BUF_@BUF.]+1 IFNOT FIRST THEN GOTO XFER IBUF4_[IBUF3_[IBUF2_[IBUF_@I.BUF]+2]+1]+1 IBU15 _[IBUF9_[IBUF8_[IBUF7_[IBUF6_[IBUF5_ \ SET UP BUFFER ADDRESSES IBUF4+1 ]+1]+1]+1]+1]+6 $IBUF_[IF $LGOTK<0 THEN 3,ELSE 2] $(IBUF2 )_2 $(IBUF3 )_($LGOTK AND 77600K)-<9 $IBUF4,$IBU15_0 $IBUF7_200K $(IBUF5)_([MXRC_LG.S()]+3) $IBUF6_64 $(IBUF8 )_[IF $IBUF=3 THEN $SECT3,ELSE $SECT2] $(IBUF9 )_$XEQT RWNDF(I.BUF,.E.R.) IER. DO[RC,FIRST,ENFLG_0;READR] XFER: IFNOT ENFLG THEN GOTO LGRD2 IF ENFLG=1 THEN[ENFLG_2;IL_0;RETURN] LGRD1:DO[ENFLG_0;IF ADD#@PLIST THEN READR;IL_-1;\ IF RC>MXRC THEN RETURN] LGRD2:GET(BUF.,1) IFNOT $BUF THEN GO TO LGRD1 GET ( $BUF1 ,[IL_$BUF-<8]-1) CK.SM(BUF.,1)?[GOTO ABORT] IF ( $BUF1 AND 160000K)=120000K THEN ENFLG_1 RETURN ABORT:MSS.(7) ABOR: IFNOT TYPE THEN GO TO EXIT ! IF TYPE ZERO THEN EXIT DO[$(@O.BUF+15)_0;IRBN(1),IRBN(2)_-1;GO TO TRUN] END ! ! GET: SUBROUTINE(DS,NO) ED_@DS+NO-1 FOR I_@DS TO ED DO THRU GET0 $I_$ADD ADD_ADD+1 GET0: IF ADD=ENADD THEN READR RETURN END ! READR:SUBROUTINE DO[READF(I.BUF,.E.R.,PLIST);IER.] ENADD_[ADD_@PLIST]+64 RC_RC+1 RETURN END ! LG.S: FUNCTION FEXIT LG.SV_((($LGOC AND 77600K)-($LGOTK AND 77600K))\ -<9)*[IF $LGOTK<0 THEN $SECT3,ELSE $SECT2]\ +($LGOC AND 177K) IF LG.SV THEN RETURN,ELSE FRETURN END END END$