ASMB,R,L,C
      HED (FMGR) CO.UT: COPY COMMAND UTILITY ROUTINES 
*     NAME:    CO.UT
*     SOURCE:  92070-18317
*     RELOC:   92070-16317
*     PGMR:    E.D.B. 
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      NAM CO.UT,7 92070-1X317 REV.2014 800331 
* 
      ENT CLR.C, DR.CT, IF.ER, CK.NM
* 
      EXT DR.RD, MSS., F.TST, LOCK. 
      EXT PK.DR, CAM.O, C.BUF, INT. 
      EXT REIO, .ENTR 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     CLR.C: CLEAR DESTINATION DISC 
* 
*     THIS ROUTINE PURGES ALL FILES FROM A CARTRIDGE EXCEPT BOOTEX. 
*     IF BOOTEX IS FOUND AS THE FIRST FILE IN THE DIRECTORY, IT 
*     IS LEFT INTACT, OTHERWISE, IT IS PURGED.
* 
*     CALLING SEQUENCE: 
* 
*     CALL CLR.C(LU)
* 
*     WHERE:
* 
*     LU      IS THE +CRN/-LU OF THE DISC CARTRIDGE TO BE CLEARED 
* 
*     DR.CT: CREATE PSEUDO-DIRECTORY
* 
*     THIS ROUTINE CREATES A PSEUDO-DIRECTORY IN LOCAL MEMORY 
*     FROM THE CARTRIDGE DIRECTORY OF THE CARTRIDGE SPECIFIED.
*     A MAXIMUM OF DIRMX FILES ARE STORED INTO THE NAME ARRAY,
*     WITH THE FILE'S NAME, TYPE, NUMBER OF EXTENTS, SIZE,
*     AND SECURITY CODE BEING STORED.  THE MORE FLAG WILL BE
*     SET IF ALL OF THE ENTRIES IN THE DIRECTORY HAVE NOT BEEN
*     SCANNED.
* 
*     CALLING SEQUENCE: 
* 
*     CALL DR.CT(LU,NAME,DIRMX,DIRLN,MORE)
* 
*     WHERE:
* 
*     LU      IS THE +CRN/-LU OF THE DISC CARTRIDGE TO BE USED
* 
*     NAME    WILL BE THE PSEUDO-DIRECTORY (8 X DIRMX WORD ARRAY) 
* 
*     DIRMX   IS THE LENGTH OF THE NAME ARRAY 
* 
*     DIRLN   WILL BE THE ACTUAL LENGTH OF THE RETURNED DIRECTORY 
* 
*     MORE    WILL BE NON-ZERO IF THERE IS MORE DIRECTORIES TO BE 
*             READ
* 
*     IF.ER: TRAP FMP ERRORS
* 
*     THIS ROUTINE WILL TEST THE PASSED ERROR CODE. IF THE ERROR
*     CODE IS NEGATIVE (FMP ERROR), IT WILL BE PRINTED ONTO THE 
*     LOG LU, AND RETURN TO THE LOCATION SPECIFIED IN THE PARAMETER 
*     LIST. OTHERWISE, NOTHING WILL BE DONE, AND THE ROUTINE WILL 
*     ROUTINE NORMALLY. 
* 
*     CALLING SEQUENCE: 
* 
*     CALL IF.ER(ERR,ERLBL) 
* 
*     WHERE:
* 
*     ERR     IS THE SUSPECTED ERROR CODE 
* 
*     ERLBL   IS THE ADDRESS TO RETURN IF AN ERROR IS DETECTED
* 
*     CK.NM: CHECK NAME FOR EQUALITY
* 
*     CALLING SEQUENCE: 
* 
*     CALL CK.NM(NAME1,NAME2) 
* 
*     WHERE:
* 
*     NAME1   IS THE FIRST NAME TO BE CHECKED 
* 
*     NAME2   IS THE SECOND NAME TO BE CHECKED
* 
*     THE E-REGISTER WILL BE CLEARED (0) IF NAMES ARE EQUAL 
      SKP 
* 
*     CLR.C 
* 
LU    NOP 
* 
CLR.C NOP 
      JSB .ENTR     GET PARAMETERS
      DEF LU
* 
*     PROCESS REQUEST 
* 
      LDA INT.      GET INTERACTIVE FLAG
      SZA,RSS       IF NOT INTERACTIVE, 
      JMP CLR.5      THEN ASSUME HE KNOWS WHAT HE'S DOING 
* 
*     MAKE SURE HE KNOWS WHAT HE'S DOING
* 
REPRM JSB REIO      OUTPUT FMGR 060 ERROR 
      DEF *+5 
      DEF .2
      DEF CAM.O 
      DEF PRMNT 
      DEF .31 
* 
      LDA CAM.O     GET OUTPUT LOG LU 
      IOR B400       SET OPTION 
      STA ADDR        AND SAVE
* 
      JSB REIO      GET RESPONSE
      DEF *+5 
      DEF .1
      DEF ADDR
      DEF C.BUF 
      DEF .36 
* 
      SSA           IF NO RESPONSE
      JMP REPRM      THEN REPROMPT USER 
* 
      LDA C.BUF     GET RESPONSE
      CPA .YE       IF YES, 
      JMP CLR.5      THEN CONTINUE
* 
      CPA .NO       IF NO,
      JMP ER60       THEN EXIT
      JMP REPRM      ELSE REPROMPT
      SKP 
* 
*     GET OLD DIRECTORY AND FIX UP
* 
CLR.5 JSB DR.RD     READ IN FIRST BLOCK OF DIRECTORY
      DEF *+4 
      DEF .1
      DEF LU,I
      DEF ZERO
* 
      JSB CK.NM     CHECK IF FIRST NAME IS BOOTEX 
      DEF *+3 
      DEF PK.DR+16
      DEF "BOOT 
* 
      SEZ           IF ALL THREE WORDS CORRECT, 
      JMP NBOOT      THEN DO NO BOOT STUFF
* 
      LDA PK.DR+4   GET FIRST FMP TRACK FROM CARTRIDGE HEADER 
      STA PK.DR+9    SAVE AS NEXT AVAILABLE TRACK 
      LDA PK.DR+5   GET FIRST AVAILABLE SECOTR FROM HEADER
      AND NB400      CLEAR SECTOR FIELD 
      ADA PK.DR+22    ADD BOOTEX SIZE 
      STA PK.DR+5    SAVE AGAIN 
      LDA .32       LOCATE NEW END OF DIRECTORY OFFSET
      JMP WRIT
* 
NBOOT LDA PK.DR+4   GET FIRST FMP TRACK FROM CARTRIDGE HEADER 
      STA PK.DR+9    SAVE AS NEXT AVAILABLE TRACK 
      LDA PK.DR+5   GET FIRST AVAILABLE SECTOR FROM HEADER
      AND NB400      CLEAR SECTOR FIELD 
      STA PK.DR+5     SAVE AGAIN
      LDA .16       LOCATE NEW END OF DIRECTORY OFFSET
      SKP 
* 
*     WRITE OUT NEW DIRECTORY 
* 
WRIT  STA B         COPY OFFSET INTO B
      ADA N128      CALCULATE NUMBER OF WORDS TO ZERO 
      STA COUNT 
      ADB APK.D     CALCULATE FIRST WORD TO ZERO
      CLA           FETCH A ZERO
* 
CLR.3 STA B,I       SET A ZERO
      INB           INCREMENT ADDRESS 
      ISZ COUNT     IF NOT FINISHED,
      JMP CLR.3      THEN DO ANOTHER WORD 
* 
      JSB LOCK.     LOCK CARTRIDGE
      DEF *+3 
      DEF LU,I
      DEF .3        LOCK REQUEST
* 
      SEZ           IF COULDN'T LOCK, 
      JMP ER60       THEN TAKE ERROR EXIT 
* 
      JSB DR.RD     WRITE OUT NEW FIRST BLOCK 
      DEF *+4 
      DEF .2
      DEF LU,I
      DEF ZERO
* 
      LDA N128      SET 
      STA COUNT      COUNT TO -128
      LDB APK.D     GET ADDRESS OF BUFFER 
      CLA           FETCH A ZERO
      STA BLK        CLEAR BLK
* 
CLR.2 STA B,I        ZERO OUT BUFFER
      INB           INCREMENT ADDRESS 
      ISZ COUNT     IF NOT FINISHED,
      JMP CLR.2      THEN DO ANOTHER WORD 
* 
CLR.1 ISZ BLK       INCREMENT BLOCK 
      JSB DR.RD     WRITE OUT NEW BLOCK 
      DEF *+4 
      DEF .2
      DEF LU,I
      DEF BLK 
* 
      SEZ,RSS       IF WRITE OK,
      JMP CLR.1      THEN WRITE OUT ANOTHER BLOCK 
* 
      JSB LOCK.     UNLOCK THE CARTRIDGE
      DEF *+3 
      DEF LU,I
      DEF .5
* 
      CLA           NO ERROR INTENDED 
      JMP CLR.C,I   RETURN
* 
ER60  LDA .60       SET FMGR 60 ERROR 
      JMP CLR.C,I   RETURN
      SKP 
* 
*     DR.CT 
* 
SLU   NOP 
NAME  NOP 
DIRMX NOP 
DIRLN NOP 
MORE  NOP 
FIRST NOP 
LAST  NOP 
* 
DR.CT NOP 
      JSB .ENTR     GET PARAMETERS
      DEF SLU 
* 
*     PROCESS REQUEST 
* 
      LDA SBLK      GET LAST BLOCK NUMBER 
      LDB MORE,I    GET MORE FLAG 
      SZB           IF NOT FIRST TIME HERE, 
      JMP NOTFR      THEN CONTINUE
* 
      CLA           START AT BLOCK 0
      STA FRST?     ALSO CLEAR FIRST-FLAG 
      STA LAST?      AND FLAST-FLAG 
* 
NOTFR STA BLK       SAVE BLOCK NUMBER 
      CLA 
      STA DIRLN,I   CLEAR DIRECTORY LENGTH
      STA MORE,I     AND MORE FLAG
      SKP 
* 
*     IF THERE IS ENOUGH ROOM IN TABLE FOR ONE MORE DIRECTORY BLOCK 
*     (EIGHT ENTRIES), OR IF THE MORE FLAG IS SET (SO WE CAN SEARCH 
*     FOR EXTENTS) THEN CONTINUE
*     OTHERWISE SET THE MORE FLAG AND SAVE THE CURRENT BLOCK NUMBER 
*     FOR LATER AND CONTINUE (BUT DON'T CREATE NEW ENTRIES) 
* 
LOOP1 LDA DIRLN,I   GET CURRENT LENGTH
      CMA            INCREMENT AND NEGATE 
      ADA DIRMX,I     ADD IN MAX LENGTH 
      SSA,RSS       IF NOT TOO FULL,
      JMP DIRC1      THEN CONTINUE
* 
      LDA MORE,I    GET MORE FLAG 
      SZA           IF ALREADY SET, 
      JMP DIRC1      THEN CONTINUE
* 
      LDA BLK       GET CURRENT BLOCK 
      STA SBLK       SAVE FOR NEXT TIME 
      ISZ MORE,I    SET MORE FLAG 
* 
DIRC1 JSB DR.RD    READ IN THE NEXT DIRECTORY BLOCK 
      DEF *+4       INTO PK.DR
      DEF .1
      DEF SLU,I 
      DEF BLK 
* 
      SEZ          IF FAIL-RETURN,
      JMP DR.CT,I   THEN RETURN 
* 
      LDA N8       SET COUNTER FOR NUMBER OF ENTRIES PER BLOCK
      STA COUNT 
      LDB APK.D    GET ADDRESS OF FIRST ENTRY IN BUFFER 
      STB ADDR      SAVE FOR LATER
* 
LOOP2 LDA ADDR,I   GET WORD 0 OF AN ENTRY 
      SZA,RSS      IF END OF THE DIRECTORY, 
      JMP DR.CT,I   THEN RETURN 
* 
      SSA          IF PURGED OR CARTRIDGE ENTRY,
      JMP DIRC2     THEN IGNORE THIS ENTRY
* 
      LDB ADDR     GET ENTRY BUFFER ADDRESS 
      ADB .5       BUMP TO EXTENT WORD (WORD 5) 
      LDA B,I      GET IT 
      AND NB400     ISOLATE EXTENT FIELD
      SZA,RSS      IF NOT EXTENT, 
      JMP DIRC3     THEN TRY ADDING TO TABLE
      SKP 
* 
*     SEARCH PSEUDO-DIRECTORY FOR THE EXTENT'S NAME.
*     IF FOUND, THEN INCREMENT THE FILE'S EXTENT COUNTER. 
*     (NO NEW ENTRY IS MADE FOR THE EXTENT) 
*     IF NOT FOUND, THEN IGNORE IT. 
* 
      LDA DIRLN,I   GET PSEUDO-DIRECTORY LENGTH 
      SZA,RSS       IF DIRECTORY EMPTY, 
      JMP DIRC2      THEN IGNORE EXTENT 
* 
      CMA,INA       NEGATE LENGTH 
      STA COUN2      AND SAVE 
* 
      LDA NAME      GET ADDRESS OF PSEUDO-DIRECTORY 
      STA INDX       SAVE FOR INDEXING
* 
LOOP3 JSB CK.NM     CHECK NAME WITH TABLE ENTRY 
      DEF *+3 
      DEF INDX,I
      DEF ADDR,I
* 
      SEZ           IF NAME DOESN'T MATCH,
      JMP NOMCH      THEN CONTINUE
* 
      LDA INDX      BUMP TO NUMBER OF EXTENTS 
      ADA .4
      ISZ A,I        AND INCREMENT
      JMP DIRC2       GO TO NEXT ENTRY
* 
NOMCH LDA INDX      BUMP TO 
      ADA .8         NEXT 
      STA INDX        ENTRY 
      ISZ COUN2     IF NOT FINISHED,
      JMP LOOP3      THEN TEST NEXT ONE 
      JMP DIRC2     OTHERWISE IGNORE IT 
      SKP 
* 
*     PROCESS MAIN FILE ENTRIES 
* 
DIRC3 LDA MORE,I    GET MORE FLAG 
      SZA           IF JUST LOOKING AT EXTENTS
      JMP DIRC2      THEN IGNORE THIS ENTRY 
* 
      LDA LAST?     FETCH LAST FLAG 
      SZA           IF PAST LAST FILE,
      JMP DIRC2      THEN IGNORE THIS ENTRY 
* 
*     CHECK FOR FIRST AND LAST SELECTIONS 
* 
      LDA FIRST,I   GET FIRST WORD OF FIRST 
      SZA,RSS       IF ZERO,
      JMP OK1        THEN SET FIRST FLAG
* 
      JSB CK.NM     CHECK IF NAME IS FIRST
      DEF *+3 
      DEF ADDR,I
      DEF FIRST,I 
* 
      SEZ,RSS       IF NAME IS THE FIRST ONE, 
OK1   ISZ FRST?      THEN SET FIRST-FOUND 
* 
      JSB CK.NM     CHECK IF NAME IS LAST 
      DEF *+3 
      DEF ADDR,I
      DEF LAST,I
* 
      SEZ,RSS       IF NAME IS THE LAST ONE SELECTED, 
      ISZ LAST?      THEN SET LAST-FOUND
* 
      LDA FRST?     FETCH FIRST FLAG
      SZA,RSS       IF NOT SET, 
      JMP DIRC2      THEN IGNORE THIS ENTRY 
* 
      JSB F.TST     CHECK AGAINST FILTER
      DEF *+2 
      DEF ADDR
* 
      SZA,RSS       IF NOT OK,
      JMP DIRC2      THEN IGNORE THIS ENTRY 
      SKP 
* 
*      SAVE FILE INFO 
* 
      LDB DIRLN,I   GET DIRECTORY LENGTH
      ISZ DIRLN,I   INCREMENT DIRECTORY LENGTH
      BLF,BRS         MULTIPLY BY 8 
      ADB NAME         OFFSET FROM BASE ADDRESS 
* 
      LDA ADDR,I    GET 2 CHARS FROM NAME 
      STA B,I        SAVE 
      ISZ ADDR      MOVE TO WORD 1
      INB 
      LDA ADDR,I    GET 2 CHARS FROM NAME 
      STA B,I        SAVE 
      ISZ ADDR      MOVE TO WORD 2
      INB 
      LDA ADDR,I    GET 2 CHARS FROM NAME 
      STA B,I        SAVE 
      ISZ ADDR      MOVE TO WORD 3
      INB 
      LDA ADDR,I    GET FILE TYPE 
      STA B,I        SAVE 
      INB 
      CLA           SET EXTENT TO ZERO
      STA B,I 
      ISZ ADDR      MOVE TO WORD 6
      ISZ ADDR
      ISZ ADDR
      INB 
      LDA ADDR,I    GET FILE SIZE (IN SECTORS)
      ARS            CONVERT TO BLOCKS
      STA B,I         SAVE
      ISZ ADDR      MOVE TO WORD 7
      INB 
      LDA ADDR,I    GET FILE RECORD LENGTH (IN WORDS) 
      STA B,I        SAVE 
      ISZ ADDR      MOVE TO WORD 8
      INB 
      LDA ADDR,I    GET SECURITY CODE 
      STA B,I        SAVE 
* 
      LDA .8        MOVE TO NEXT ENTRY
      RSS 
* 
*     MOVE TO ANOTHER ENTRY 
* 
DIRC2 LDA .16       MOVE TO NEXT ENTRY
      ADA ADDR
      STA ADDR
      ISZ COUNT     IF NOT DONE WITH BLOCK, 
      JMP LOOP2      THEN DO ANOTHER ENTRY
* 
      ISZ BLK       INCREMENT CURRENT BLOCK NUMBER
      JMP LOOP1      AND GO READ ANOTHER BLOCK
      SKP 
* 
*     IF.ER 
* 
ERR   NOP 
RTN   NOP 
* 
IF.ER NOP 
      JSB .ENTR     GET PARAMETERS
      DEF ERR 
* 
*     PROCESS REQUEST 
* 
      LDA ERR,I     GET SUSPECTED ERROR 
      SSA,RSS       IF NOT ERROR, 
      JMP IF.ER,I    THEN RETURN
* 
      ADA N2000     SUBTRACT 2000 SO WE DON'T TRANSFER CONTROL
      STA ERR        AND SAVE FOR MSS 
* 
      JSB MSS.      PRINT ERROR 
      DEF *+2 
      DEF ERR 
* 
      JMP RTN,I     AND TAKE ERROR RETURN 
      SKP 
* 
*     CK.NM: CHECK NAME 
* 
NAME1 NOP 
NAME2 NOP 
* 
CK.NM NOP 
      JSB .ENTR 
      DEF NAME1 
* 
*     PROCESS REQUEST 
* 
      LDB N3        PRESET COUNTER TO -3
      LDA NAME1,I   GET 2 CHARS FROM NAME 
      CPA NAME2,I   IF SAME AS IN TABLE,
      INB            THEN BUMP COUNTER
* 
      ISZ NAME1     BUMP TO NEXT WORDS
      ISZ NAME2 
      LDA NAME1,I 
      CPA NAME2,I   IF SAME AS IN TABLE,
      INB            THEN BUMP COUNTER
* 
      ISZ NAME1     BUMP TO LAST WORDS
      ISZ NAME2 
      LDA NAME1,I 
      CPA NAME2,I   IF SAME AS IN TABLE,
      INB            THEN BUMP COUNTER
* 
      CLE,SZB       IF NAME DON'T MATCH,
      CCE            THEN SET E FOR FAILURE 
      JMP CK.NM,I   RETURN
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP 
* 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.8    DEC 8 
.16   DEC 16
.31   DEC 31
.32   DEC 32
.36   DEC 36
.60   DEC 60
* 
N3    DEC -3
N8    DEC -8
N128  DEC -128
N2000 DEC -2000 
* 
B400  OCT 400 
NB400 OCT -400
* 
.YE   ASC 1,YE
.NO   ASC 1,NO
"BOOT ASC 3,BOOTEX
PRMNT ASC 24,FMGR 060 DO YOU REALLY WANT TO PURGE THIS DISC?
      ASC  6,(YES OR NO). 
      OCT 20137     CR + LF 
* 
APK.D DEF PK.DR 
* 
BLK   NOP           CURRENT BLOCK NUMBER
SBLK  NOP           LAST EXAMINED BLOCK NUMBER
COUNT NOP 
COUN2 NOP 
INDX  NOP 
ADDR  NOP 
* 
FRST? NOP 
LAST? NOP 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END