SPL,L,O,M,C ! NAME: CO.PK ! SOURCE: 92064-18045 ! RELOC: 92064-16017 ! PGMR: 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 CO.PK(7) " 92064-16017 REV.1650 761104" ! ! ! LET OPEN.,FCONT,READF,WRITF,MSS. BE SUBROUTINE,EXTERNAL LET .P1,.P2,IDCB1,IDCB2,I.BUF \ BE INTEGER,EXTERNAL LET CLD.R BE SUBROUTINE,DIRECT,EXTERNAL ! ! LET IFBRK BE FUNCTION,EXTERNAL ! LET PK.. BE SUBROUTINE LET WRIT,DCHCK BE SUBROUTINE,DIRECT ! LET DIR BE INTEGER LET BL.S BE CONSTANT (20123K) !BLANK B LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! ! ! ! PK..: SUBROUTINE(NO,LIS,ER) GLOBAL CO..: ASSEMBLE "EQU PK.." ASSEMBLE "ENT CO.." ! ! DIR2_0 !THIS PREVENTS WRITING OVER SOME !WHERE UNKNOWN IN THE KILL SECT. ! ! ! SETUP CMND ADDRESSES AND USE RESULT BUFFER(LIS) ! AS FILE# & TYPE TABLE ! C2_[C2T_[C1_[C1T,FTAB_ @LIS]+1]+3]+1 ! ! SET ADDRESS OF FILE TYPE WORD AND I.BUF ! TYPE_[I,IBUF_@I.BUF]+3 ! ! DETERMINE "FROM,TO, OR DEFAULT LU'S" ! CHECK FOR BAD PARM,IF SO EXIT-ERR 56 ! ALLOW POS AND NEG LU ! ! IF $C1T=3 THEN GO TO ER56 ,\ ELSE [IFNOT $C1T THEN C1_4 ,\ !DEFAULT TO 4 ELSE [IF [C1_ $C1] < 0 THEN C1_ - C1]] ! ! IF $C2T=3 THEN [\ ER56: ER_56 ;RETURN] , \ ELSE [IFNOT $C2T THEN C2_5 , \ !DEFAULT TO 5 ELSE [IF [C2_ $C2] < 0 THEN C2_ - C2]] ! ! IF C1=C2 THEN GO TO ER56 !FROM AND TO MUST BE DIFFERENT ! ! ! ! ! ! LOCK FROM UNIT ! VIA A CALL TO D.R ! .P2_ - C1 !SET NEG LU FOR CALL .P1_ 3 !FUNCTION CODE FOR LOCK CLD.R ! GO SCHED D.R ! ! ! CHECK FOR D.R ERRORS ! IF [ER_ $[TEMP_ $B]] THEN RETURN !ERROR CHECK AND SAVE B ! ! ! CALCULATE DIRECTORY ADDRESS ! FOR THIS UNIT ! AND REJECT IF DIRECTORY NOT VALID ! ! IF ($$[T2_$(TEMP+2)-3]) THEN [ER_24;GOTO KILL] DIR_$(T2+1) ! ! ! ! ! ! ! ! ! ! ! LOCK "TO" UNIT ! CHECK FOR LOCK ERRORS ! PK.2: .P2_ - C2 ! SET NEG LU FOR CALL CLD.R ! CALL D.R ! IF[ER_ $[TEMP_ $B]] THEN GO TO KILL ! ! SET CARTRIDGE DIR ADDRESS ! DIR2_ $ ( TEMP+2 ) ! ! OPEN BOTH UNITS IN ASCII MODE ! CALL OPEN.(IDCB1, C1,0,400K) CALL OPEN.(IDCB2, C2,0,400K) ! ! REWIND BOTH UNITS ! CALL FCONT(IDCB1,ER,400K) CALL FCONT(IDCB2,ER,400K) ! ERROR CHECK NEEDED HERE? ! ! FILEX_ 1 !PRESET FILE# PAST DIR ! ! STP_ $(DIR-1) DIR_DIR-4 !ADJUST FOR PACK LOOP ! ! START LOOP FOR PACK DIRECTORY UPDATE ! THIS ROUTINE ALSO BUILDS A FILE# AND TYPE TABLE ! FOR ALL NON PURGED FILES ! ! SIGN SET=BINARY,LOW 4 BITS GIVE FILE # ON FROM DEVICE ! 0=END OF TABLE ! ! ! ! AGAIN: $FTAB_0 !SET END OF TABLE AG2: DIR_DIR+4 FILEX_FILEX+1 ! CALL READF(IDCB1,ER,I.BUF,128,LEN) !READ DIRECTORY ENTRY IF ER THEN GO TO KILL IFNOT (LEN= -1) THEN GO TO MORE !IF NOT EOF,CONTINUE ! ! FOUND EOF--MUST BE AT END OF DIRECTORY ! IF ($DIR=0) OR (DIR=STP) THEN \ [WRIT ;GO TO CPY],\ OK-WRITE EOF ELSE [ER_ 24 ;GO TO KILL] ! ! ! MORE: CALL DCHCK !GO CHECK DIRECTORY JUST READ IF $DIR=0 THEN [ ER_ 24 ; GO TO KILL] !CHECK MEM COPY IF $DIR < 0 THEN GO TO AG2 ! PURGED SO SKIP IT $FTAB_ [IF [I_ $(DIR+3)]= BL.S THEN \ FILEX,\ ELSE FILEX OR 100000K ] ! ! FTAB_FTAB+1 !BUMP TABLE POINTER ! ! TYPES MUST COMPARE ! IF I # $TYPE THEN [ER_ 24 ; GO TO KILL] ! ! MOVE IN MEMORY RESIDENT PORTION OF ENTRY ! ! TEMP_ DIR FOR I_@I.BUF TO @I.BUF+3 DO\ [ $I_ $TEMP;TEMP_ TEMP+1] ! CALL WRIT !WRITE NEW ENTRY ! ERROR CHECK?? ! GO TO AGAIN ! ! ! ! ! CPY: FTAB_ @LIS !RESET TABLE POINTER OUT_ @IDCB2 +3 IN1_ @IDCB1 +3 ! CPY2: IFNOT $FTAB THEN GO TO KILL ! ! SET OR CLEAR BINARY(M) BIT IN DCB--SUB FUNCTION ! $IN1_ [IF $FTAB < 0 THEN $IN1 OR 100K ,\ ELSE $IN1 AND 177677K ] ! $OUT_ [IF $FTAB < 0 THEN $OUT OR 100K ,\ ELSE $OUT AND 177677K] ! ! LOCATE ABS FILE# ON FROM DEVICE ! CALL FCONT(IDCB1,ER,2700K,($FTAB AND 17K)) ! CPY3: CALL READF(IDCB1,ER,I.BUF,128,LEN) CALL WRIT IF ER THEN GO TO KILL ! IF IFBRK THEN [MSS.(0);GO TO KILL] IF LEN= -1 THEN [FTAB_ FTAB+1;GO TO CPY2],\ ELSE GO TO CPY3 ! ! ! ! KILL: .P1_5 !FUNCTION CODE FOR LOCK CLEAR .P2_- C1 CLD.R !GO CLEAR LOCK ON FROM DEVICE ! .P2_- C2 ! ! MARK "TO" UNIT INVALID ASSEMBLE "LDA DIR2 FETCH CRDIR POINTER" ASSEMBLE "SZA,RSS IF ZERO-- " ASSEMBLE "JMP ALMST THE WORK WAS ABORTED" ASSEMBLE "ADA N3 BACK UP TO VALIDITY ADDRESS" ASSEMBLE "LDB 0,I FETCH IT" ! ASSEMBLE "LDA DEFX ADDRESS OF NON-ZERO WORD" ASSEMBLE "EXT PMOVE" ASSEMBLE "JSB PMOVE" ASSEMBLE "OCT 1" ALMST: CLD.R !GO CLEAR "TO" DEVICE LOCK RETURN ! ! ! ! ! ! DEFX: ASSEMBLE "DEF *" N3: ASSEMBLE "OCT -3" END ! ! WRIT: SUBROUTINE DIRECT CALL WRITF(IDCB2,ER,I.BUF,LEN) RETURN END ! DCHCK: SUBROUTINE DIRECT IF LEN<4 THEN GO TO BDIR !MUST HAVE AT LEAST 4 WORDS IF ($( @ I.BUF+3) AND 177400K) # 20000K \ !CHAR 7 MUST BE THEN [\ !ASCII BLANK BDIR: ER_24;GO TO KILL] RETURN END ! ! END END$