ASMB,R,L,C
      HED (FMGR) CO.UT: COPY COMMAND UTILITY ROUTINES 
*     NAME:    CO.UT
*     SOURCE:  92071-18317
*     RELOC:   92071-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 92071-1X317 REV.2041 800630 
* 
      ENT CLR.C, IF.ER, CK.NM 
* 
      EXT DR.RD, MSS. 
      EXT PK.DR, CAM.O, C.BUF, INT. 
      EXT CRLK, CRULK 
      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 
* 
* 
*     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+6   GET WORD CONTAINING SECTORS / TRACK 
      AND B377       ISOLATE SECTORS / TRACK
      STA SC/TR       SAVE
* 
      LDA PK.DR+21  GET BOOTEX SECTOR ADDRESS 
      ADA PK.DR+22   ADD BOOTEX SIZE
      CLB             CLEAR FOR DIVIDE
      DIV SC/TR        DIVIDE INTO TRACK AND SECTOR 
      ADA PK.DR+20  ADD BOOTEX TRACK ADDRESS
* 
      STA PK.DR+9   SAVE NEXT AVAILABLE TRACK 
      LDA PK.DR+5   GET WORD CONTAINING NEXT AVAILABLE SECTOR 
      AND NB400      ISOLATE CPU USE FIELD
      IOR B           MERGE WITH NEXT AVAILABLE SECTOR
      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 WORD CONTAINING NEXT AVAILABLE SECTOR 
      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 CRLK      LOCK CARTRIDGE
      DEF *+2 
      DEF LU,I
* 
      SZA           IF ERROR OCCURED, 
      JMP EREX       THEN 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 CRULK     UNLOCK THE CARTRIDGE
      DEF *+2 
      DEF LU,I
* 
      CLA           NO ERROR INTENDED 
      JMP CLR.C,I   RETURN
* 
ER60  LDA .60       SET FMGR 60 ERROR 
* 
EREX  JMP CLR.C,I   RETURN
      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 
.16   DEC 16
.31   DEC 31
.32   DEC 32
.36   DEC 36
.60   DEC 60
* 
N3    DEC -3
N128  DEC -128
N2000 DEC -2000 
* 
B377  OCT 377 
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
COUNT NOP 
ADDR  NOP 
SC/TR NOP           SECTORS/TRACK 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                                                                                                                                          