0001 ! Written by Tom Cadwallader HPX <46> ! Version 09/15/87
0002 ! Requires disc with volume label ".BACKUP"
0003 ! File #1 on .BACKUP must be RECOVER (by TBC HPX <46>)
0004 ! File #2 on .BACKUP must be ROMCOPY (HP LEX File: NOMAS)
0005 ! CALL BACKUP(1) purges .BACKUP files #3 to N and auto-
0006 !      copies IRAM to files named PORTxDxxXX where xDxx
0007 !      is the source PORT and XX is the ROM filesize (K)
0008 !      and copies :MAIN to files PORTxDxxXX +1 to N
0009 ! CALL BACKUP(2) purges .BACKUP files PORTxDxxXX +1 to N
0010 !      and copies :MAIN to files PORTxDxxXX +1 to N
0011 ! CALL BACKUP(3) or RUN BACKUP purges no .BACKUP files
0012 !      and copies :MAIN to files PORTxDxxXX +1 to N
0013 !      that is, overwrites or replaces :MAIN files on
0014 !      .BACKUP
0015 !
0016 ! THIS IS NOT A FINAL PRODUCT, BUT IT DOES WORK ...
0017 ! A test is required on Line 1010 for 'keys', 'workbook'
0018 !      as the first :MAIN file or '' (no :MAIN files)
0019 !
0020 ! Requires REV$ and RTRIM$ in STRINGLX and MSG$ in CUSTUTIL
0100 !
0200 !
0300 !
0400 !
0500 ! Companion program RECOVER is under development ...
0600 !
0700 !
0800 !
0900 !
1000 CALL BACKUP(3) @ SUB BACKUP(B) @ ON ERROR GOSUB 1500
1010 D$=".BACKUP" @ D=DEVADDR(D$) @ IF D=-1 THEN GOTO 1540
1020 IF CAT$(1,D$)[1,7]#"RECOVER" THEN GOTO 1550
1030 IF CAT$(2,D$)[1,7]#"ROMCOPY" THEN GOTO 1550
1040 ON B GOTO 1100,1200,1300
1100 F=3 @ GOSUB 1400
1110 L=HTD(ADDR$(CAT$(1)))-HTD("2F9E6")
1120 DIM T$[L] @ T$=PEEK$("2F9E6",L)
1130 T$=T$[HTD(REV$(T$[3,5]))+6] @ T$=T$[6,HTD(REV$(T$[3,5]))+5]
1140 FOR T=1 TO LEN(T$)/10 @ FIX 2 @ IF T$[8,8]#"0" THEN 1190
1150 P$=":PORT("&STR$(HTD(T$[3,3])+HTD(T$[2,2])*.01)&")"
1160 R$="PORT"&T$[3,3]&"D"&STR$(HTD(T$[2,2])*.01)[3]
1170 STD @ S=2^(15-HTD(T$[4,4]))*(HTD(T$[9,9])+1)*1024/2
1175 S$=STR$(S) @ IF S<10000 THEN S$="0"&S$[1,1] ELSE S$=S$[1,2]
1180 R$=R$&S$ @ DISP P$&" "&R$ @ ROMCOPY P$ TO R$&D$; ROMSIZE=S
1190 T$=T$[11] @ NEXT T @ GOTO 1300
1200 FOR F=3 TO INF @ F$=CAT$(F,D$)[1,4]
1210 IF F$#"PORT" THEN GOSUB 1400 @ GOTO 1300
1220 NEXT F
1300 K$="KEYS" @ RENAME KEYS TO K$ @ NAME WORKFILE
1310 FOR C=1 TO INF @ C$=CAT$(C)[1,22] @ IF C$="" THEN 1330
1320 DISP C$ @ COPY C$[1,8] TO D$ @ NEXT C
1330 RENAME K$ TO KEYS @ END 
1400 FOR P=1 TO INF @ P$=RTRIM$(CAT$(F,D$)[1,10])
1410 IF P$="" THEN PACK D$ @ RETURN 
1420 PURGE P$&D$ @ NEXT P @ END 
1500 IF ERRN=57 OR ERRN=59 THEN RETURN ELSE BEEP 
1510 IF ERRN=255021 THEN DISP MSG$(255065)&" "&MSG$(22) @ END 
1520 IF ERRN=255029 THEN DISP MSG$(255066)&" "&MSG$(66) @ END 
1530 DISP ERRM$ @ END 
1540 DISP D$&MSG$(232) @ BEEP @ END 
1550 DISP MSG$(236)&D$ @ BEEP @ END SUB