1 ! UNITAP -- "Universal" Tape Dump Program & ! & ! Dumps various types of magtapes into RSTS files. & ! By: Larry Walker and Scott Matsumoto & ! & ! Developed at: & ! Lawrence University & ! P. O. Box 599 & ! Appleton, WI 54912 & ! 5 EXTEND 6 ON ERROR GOTO 30000 & \ JUNK% = FNINIT% ! Initialize & 10 PRINT 'Command'; & \ INPUT LINE CMD$ & \ CMD$ = CVT$$(CMD$, 255%) & 20 IF CMD$ = 'SET' THEN JUNK% = FNSET% & ELSE IF CMD$ = 'LOAD' THEN JUNK% = FNLOAD% & ELSE IF CMD$ = 'DIR' THEN JUNK% = FNDIR% & ELSE IF CMD$ = 'REWIND' THEN JUNK% = FNREWIND% & ELSE IF CMD$ = 'HELP' THEN JUNK% = FNHELP% & ELSE IF CMD$ = 'DEBUG' THEN JUNK% = FNDEBUG% & ELSE JUNK% = FNFILE.RQST% & 30 PRINT & \ GOTO 10 & & 40 DEF FNSET% & \ IF DEBUG% THEN PRINT 'Entering FNSET%' & & 50 INPUT 'Input-Record-Type '; INP$ & \ INP$ = LEFT(CVT$$(INP$, 255%), 3%) 60 IF INP$ = "" OR INP$ = 'FIX' & THEN IN.REC.TYPE% = FXD% & ELSE IF INP$ = 'VAR' & THEN IN.REC.TYPE% = VAR% & ELSE GOTO 50 & & 70 INPUT 'Character-Code '; INP$ & \ INP$ = CVT$$(INP$, 255%) 80 IF INP$ = "" OR INP$ = 'EBCDIC' & THEN ASCII.CODE% = NO% & \ XL$ = EBCDIC$ & \ GOTO 89 82 IF INP$ = 'ASCII' & THEN ASCII.CODE% = YES% & \ GOTO 89 84 IF INP$ = 'BCD' & THEN ASCII.CODE% = NO% & \ XL$ = BCD$ & \ GOTO 89 85 GOTO 70 89 ! Character set and Xlate string loaded; continue & & 90 INPUT 'Output-record-type '; INP$ & \ INP$ = LEFT(CVT$$(INP$, 255%), 3%) 100 IF INP$ = "" OR INP$ = 'FIX' & THEN OUT.REC.TYPE% = FXD% & ELSE IF INP$ = 'VAR' & THEN OUT.REC.TYPE% = VAR% & ELSE GOTO 90 & & 110 INPUT 'Omit Output Carriage-Return '; INP$ & \ INP$ = LEFT(CVT$$(INP$, 255%), 1%) 120 IF INP$ = "" OR INP$ = 'N' & THEN OMIT.CR% = NO% & ELSE IF INP$ = 'Y' & THEN OMIT.CR% = YES% & ELSE GOTO 110 & & 130 IF DEBUG% THEN PRINT 'Leaving FNSET%' 139 FNEND & 200 DEF FNLOAD% & \ IF DEBUG% THEN PRINT 'Entering FNLOAD%' & 201 OPEN TAPE.DEV$ AS FILE TAPE.CHAN%, RECORDSIZE MAX.RECL% & \ FIELD #TAPE.CHAN%, MAX.RECL% AS BUF$ & \ FIELD #TAPE.CHAN%, 4% AS LABEL$ & \ GET #TAPE.CHAN% & \ HDR.LBL$ = LABEL$ + "" & \ HDR.LBL$ = XLATE(HDR.LBL$, XL$) UNLESS ASCII.CODE% & & \ IF HDR.LBL$ = 'VOL1' & THEN TAPE.TYPE% = VOL.HDR% & \ VOL.SER$ = MID(BUF$, 5%, 6%) & \ VOL.SER$ = XLATE(VOL.SER$, XL$) UNLESS ASCII.CODE% & \ PRINT 'Vol-Ser = '; VOL.SER$ UNLESS DIR% & \ GOTO 230 & 205 IF HDR.LBL$ = 'HDR1' & THEN TAPE.TYPE% = FILE.HDR% & \ JUNK% = MAGTAPE(5%,1%,TAPE.CHAN%) ! Backspace to B-O-F & \ PRINT 'Tape has no Vol-Ser' UNLESS DIR% & \ GOTO 230 & 210 ! ELSE tape must have no Headers, so set it & TAPE.TYPE% = UN.HDR% & \ JUNK% = MAGTAPE(5%,1%,TAPE.CHAN%) ! Backspace to B-O-F & \ PRINT 'Tape has no Headers' UNLESS DIR% & 230 DSN% = 1% & \ IF DEBUG% THEN PRINT 'Leaving FNLOAD%' 239 FNEND & 300 DEF FNFILE.RQST% & \ IF DEBUG% THEN PRINT 'Entering FNFILE.RQST%' & 310 JUNK% = FNPARSE.CMD% & 320 IF TAPE.TYPE% = VOL.HDR% & THEN JUNK% = FNHDR.TYPE% & ELSE IF TAPE.TYPE% = FILE.HDR% & THEN JUNK% = FNHDR.TYPE% & ELSE IF TAPE.TYPE% = UN.HDR% & THEN JUNK% = FNNO.HDR.TYPE% & 380 ! All of the tape-format-logic routines (FNHDR.TYPE% and FNNO.HDR.TYPE% & ! are the only ones for now) assume that the tape is positioned to & ! Begin-of-File point (which may or may not coincide with Begin-of- & ! Data-Blocks (due to the possible presence of HDR blocks)). & & ! It is up to each of the tape-format-logic routines to get the tape & ! properly positioned to Begin-of-Data-Blocks (if it isn't already) & ! before calling FNDUMP%. & 388 RNDM% = NO% & \ FIRST.N% = NO% & \ SPCL.SELECT% = NO% & 390 IF DEBUG% THEN PRINT 'Leaving FNFILE.RQST%' & 399 FNEND & 400 DEF FNHDR.TYPE% & \ LOCK.LRECL% = NO% & \ MULTI.REEL% = NO% & \ IF DEBUG% THEN PRINT 'Entering FNHDR.TYPE%' & 405 IF LEFT(DSRD.FILE$, 1%) <> '#' THEN GOTO 420 406 DSRD.DSN% = VAL( RIGHT(DSRD.FILE$, 2%) ) & 408 IF DSRD.DSN% < DSN% & THEN JUNK% = MAGTAPE(3%,1%,TAPE.CHAN%) ! Rewind tape; & \ GET #TAPE.CHAN% IF TAPE.TYPE% = VOL.HDR% & \ DSN% = 1% ! Next step will & ! skip to dsrd file 410 IF DSRD.DSN% > DSN% & THEN GET #TAPE.CHAN% ! Is there another dataset? & \ JUNK% = MAGTAPE(4%,32767%,TAPE.CHAN%) FOR I%=1% TO 3% & \ DSN% = DSN% + 1% & \ GOTO 410 412 ! Set to Begin of dsrd file: Get HDR1 and grab data.set.name & 420 GET #TAPE.CHAN% 425 IF EOF% THEN PRINT 'End-of-Tape' & \ EOF% = NO% & \ GOTO 490 ! Abort if E-O-T & 430 THIS.FILE.ID$ = MID(BUF$, 5%, 17%) & \ THIS.FILE.ID$ = XLATE(THIS.FILE.ID$, XL$) UNLESS ASCII.CODE% & ! Extract the file ID from HDR1 block and XLATE if needed. & \ CR$ = MID(BUF$,42%,6%) & \ CR$ = XLATE(CR$, XL$) UNLESS ASCII.CODE% & \ DAY% = VAL( RIGHT(CR$, 4%) ) & \ YRS% = VAL( LEFT(CR$, 3%) ) - 70% & \ CR.DATE$ = DATE$( DAY% + (YRS% * 1000%) ) & ! Extract the creation-date from HDR1 and XLATE if needed. & ! Finally do a conversion from IBM's Julian date. & 432 IF DEBUG% THEN PRINT 'THIS.FILE.ID$ ='; THIS.FILE.ID$ & 434 IF LEFT(DSRD.FILE$, 1%) = '#' THEN GOTO 440 & ! Skip code that selects by file-name, since already selected by # & 436 IF DSRD.FILE$ = '*' ! "Wildcard" file dump & THEN GOTO 440 & ELSE IF DSRD.FILE$ = THIS.FILE.ID$ & THEN GOTO 440 ! Either case qualifies & ELSE JUNK% = MAGTAPE(4%,32767%,TAPE.CHAN%) FOR I%=1% TO 3% & \ DSN% = DSN% + 1% ! Skip 3 Tape Marks and go & \ GOTO 420 ! to begin of next file. & 440 GET #TAPE.CHAN% ! Get HDR2 block 442 IF EOF% & THEN JUNK% = FNGET.LRECL% & ELSE REC.LEN$ = MID(BUF$, 11%, 5%) & \ REC.LEN$ = XLATE(REC.LEN$, XL$) UNLESS ASCII.CODE% & \ LRECL% = VAL(REC.LEN$) & \ BLK.SIZE$ = MID (BUF$,6%,5%) & \ BLK.SIZE$ = XLATE(BLK.SIZE$, XL$) UNLESS ASCII.CODE% & \ BLK.SIZE% = VAL(BLK.SIZE$) & \ JUNK% = MAGTAPE(4%,32767%,TAPE.CHAN%) & ! Extract the record length from HDR2, XLATE if needed, convert & ! to integer format, and put it into LRECL%. Also get BLK.SIZE. & 450 EOF% = NO% & 470 IF MULTI.REEL% & THEN GOTO 480 & ELSE PRINT ' Now dumping '; THIS.FILE.ID$ UNLESS DIR% & \ IF LEN( OUT.FILE.ID$) = 0% & THEN & SEQ.NO% = SEQ.NO% + 1% & \ OUT.FILE.ID$ = LEFT(THIS.FILE.ID$, 6%) & \ DOT% = INSTR(1%, OUT.FILE.ID$, '.' ) ! Flush out any embedded & \ WHILE DOT% ! periods in OUT.FILE.ID$ & \ OUT.FILE.ID$ = LEFT (OUT.FILE.ID$, DOT%-1%) ! so it is a legal RSTS file-spec. & + RIGHT (OUT.FILE.ID$, DOT%+1%) & \ DOT% = INSTR(1%, OUT.FILE.ID$, '.' ) & \ NEXT & \ OUT.FILE.ID$ = OUT.FILE.ID$ + '.' + NUM$(SEQ.NO%) & & ! The preceeding will default the output file ID & ! to the first 6 characters of the dataset name, & ! plus an appended seq. no. to guarantee unique & ! file names. This happens with wildcarding. & 475 OPEN OUT.FILE.ID$ FOR OUTPUT AS FILE OUT.CHAN% UNLESS DIR% & 480 JUNK% = FNDUMP% ! Dump the data blocks & \ GET #TAPE.CHAN% ! Look for EOF1 block & 485 TLR.LBL$ = LABEL$ + "" & \ TLR.LBL$ = XLATE(TLR.LBL$, XL$) UNLESS ASCII.CODE% & \ IF TLR.LBL$ = 'EOV1' ! EOV1 means this is a multi- & THEN PRINT 'Multi-Volume file:' ! reel file; load next reel, & \ INPUT 'Type RETURN when ready', XX$! set flag and resume at & \ JUNK% = FNLOAD% ! B-O-F point (to properly & \ MULTI.REEL% = YES% ! skip HDR block(s)) & \ GOTO 420 & 486 IF TLR.LBL$ = 'EOF1' & THEN CLOSE #OUT.CHAN% UNLESS DIR% & \ JUNK% = MAGTAPE(4%,32767%,TAPE.CHAN%) ! Skip last EOF of file & \ OUT.FILE.ID$ = "" & \ DSN% = DSN% + 1% & & \ PRINT NUM.RECS; 'records written' UNLESS DIR% & \ PRINT THIS.FILE.ID$; TAB(20); LRECL%; TAB(26); & BLK.SIZE%; TAB(34); NUM.RECS; TAB(41); & CR.DATE$ IF DIR% & & \ IF DSRD.FILE$ = '*' & THEN GOTO 420 & ELSE GOTO 490 & 487 ! If TLR.LBL$ not EOV1 or EOF1, then trailer error & PRINT 'Trailer Error: '; TLR.LBL$ & 490 IF DEBUG% THEN PRINT 'Leaving FNHDR.TYPE%' 499 FNEND & 500 DEF FNDUMP% & \ IF DEBUG% THEN PRINT 'Entering FNDUMP%' & 501 GET #TAPE.CHAN% & \ NEXT.CHR% = 1% & \ NEXT.CHR% = 5% IF IN.REC.TYPE% = VAR% ! Skip 1st Block-Descriptor-Word & \ NUM.RECS = 0% & \ JUNK% = FNGET.REC% & 510 WHILE NOT EOF% & 520 OUT$ = XLATE(OUT$, XL$) UNLESS ASCII.CODE% & & 530 ! Check-Switches Section & & IF NOT FIRST.N% & THEN GOTO 532 ! GOTO Next-switch check & ELSE IF NUM.RECS < MAX.RECS% & THEN GOTO 532 ! GOTO Next-switch check & ELSE GOTO 548 ! GOTO Skip-print & 532 IF NOT RNDM% & THEN GOTO 534 ! GOTO Next-switch check & ELSE IF (RND*100) <= RNDM.FRAC% & THEN GOTO 534 ! GOTO Next-switch check & ELSE GOTO 548 ! GOTO Skip-print & 534 IF NOT SPCL.SELECT% & THEN GOTO 540 ! Switches done: continue & ELSE SELECTED% = FNSELECT% & \ IF SELECTED% & THEN GOTO 540 ! Selected: continue & ELSE GOTO 548 ! GOTO skip-print & & ! End of Check-Switches Section & & 540 OUT$ = CVT$$(OUT$, 128%) IF OUT.REC.TYPE% = VAR% & \ IF DIR% & THEN GOTO 545 & ELSE IF OMIT.CR% & THEN PRINT #OUT.CHAN%, OUT$; & ELSE PRINT #OUT.CHAN%, OUT$ & 545 NUM.RECS = NUM.RECS + 1 548 JUNK% = FNGET.REC% 550 NEXT & 560 EOF% = NO% & 590 IF DEBUG% THEN PRINT 'Leaving FNDUMP%' 598 ! This routine assumes: & ! 1) That the tape is positioned to Begin-of-Data-Blocks & ! 2) That the output file is open on channel #OUT.CHAN% & ! It then dumps all data blocks (LRECL characters per record) & ! up to the first tape mark encountered. & 599 FNEND & 600 DEF FNGET.REC% & \ ON ERROR GOTO 680 & & 610 IF NEXT.CHR% > RECOUNT & THEN GET #TAPE.CHAN% & \ NEXT.CHR% = 1% & \ NEXT.CHR% = NEXT.CHR%+4% IF IN.REC.TYPE% = VAR% ! Skip Block-Descriptor-Word & 615 IF IN.REC.TYPE% = VAR% & THEN LRECL% = CVT$%(MID(BUF$, NEXT.CHR%, 2%)) - 4% ! Get LRECL% & \ NEXT.CHR% = NEXT.CHR% + 4% ! Skip Record-Descriptor-Word & 620 OUT$ = MID(BUF$, NEXT.CHR%, LRECL%) ! Get one record & \ NEXT.CHR% = NEXT.CHR% + LRECL% & \ GOTO 690 ! Return & 680 OUT$ = "" & \ EOF% = YES% & \ RESUME 690 & 690 ON ERROR GOTO 30000 & 698 ! This routine gets input from the tape, one block at a time (as needed) & ! and doles it out one record at a time (each time it is called). & ! The record is put into OUT$ for FNDUMP$ to use as it sees fit. & ! & ! Initialization must be done before first call to FNGET.CHR$ : & ! 1) Open the tape non-file-structured as channel #TAPE.CHAN% & ! 2) Get the 1st block of the data-blocks & ! 3) Set NEXT.CHR% = 1% if Fixed Input Records & ! Set NEXT.CHR% = 5% if Variable Input Records & ! FNDUMP% does these initializations. & ! & ! Borrowed shamelessly from UNIX, via Kernigan and Plauger, "Software Tools" & 699 FNEND & 700 DEF FNNO.HDR.TYPE% & & \ MULTI.REEL% = NO% & \ LOCK.LRECL% = NO% & \ IF DEBUG% THEN PRINT 'Entering FNNO.HDR.TYPE%' & 735 IF LEFT(DSRD.FILE$, 1%) = '#' & THEN DSRD.FILE$ = RIGHT(DSRD.FILE$, 2%) & 730 IF DSRD.FILE$ = '*' & THEN GET #TAPE.CHAN% & \ JUNK% = MAGTAPE(5%, 1%, TAPE.CHAN%) & \ GOTO 765 & 740 DSRD.DSN% = VAL(DSRD.FILE$) & \ IF DSRD.DSN% = DSN% THEN GOTO 765 & 750 IF DSRD.DSN% < DSN% & THEN JUNK% = MAGTAPE(3%,1%,TAPE.CHAN%) ! Rewind tape; & \ DSN% = 1% ! Next step will & ! skip to dsrd file. & 760 IF DSRD.DSN% > DSN% & THEN SKP% = DSRD.DSN% - DSN% & \ FOR I%=1% TO SKP% & \ GET #TAPE.CHAN% & \ BLK.SIZE% = RECOUNT ! Get block-size & \ BLKS.SKPD% = MAGTAPE(4%,32767%,TAPE.CHAN%) ! Skip rest of file & \ NUM.TAPE.BLKS% = (32767% - BLKS.SKPD%) & \ PRINT 'Dataset #'; DSN%; TAB(20); '???'; & TAB(26); BLK.SIZE%; TAB(34); & NUM.TAPE.BLKS% IF DIR% & \ DSN% = DSN% + 1% & \ NEXT I% & \ GOTO 765 & 762 ! Resume here on EOT from GET above & PRINT 'Tape only contains'; DSN%-1%; 'datasets' UNLESS DIR% & \ PRINT 'End-of-tape' IF DIR% & \ GOTO 798 & 765 JUNK% = FNGET.LRECL% & 770 IF NOT MULTI.REEL% & THEN PRINT ' Now dumping Data-Set #'; DSN% & \ SEQ.NO% = SEQ.NO% + 1% IF LEN(OUT.FILE.ID$) = 0% & \ OUT.FILE.ID$ = 'FILE.' + NUM1$(SEQ.NO%) & IF LEN(OUT.FILE.ID$) = 0% & \ OPEN OUT.FILE.ID$ FOR OUTPUT AS FILE OUT.CHAN% UNLESS DIR% & 780 JUNK% = FNDUMP% ! Dump the data blocks & 790 CLOSE OUT.CHAN% & \ PRINT NUM.RECS; 'Records written' & \ DSN% = DSN% + 1% & \ OUT.FILE.ID$ = "" & \ IF DSRD.FILE$ = '*' THEN GOTO 730 & 798 IF DEBUG% THEN PRINT 'Leaving FNNO.HDR.TYPE%' 799 FNEND & 800 DEF FNINIT% & 801 NO% = 0% & \ YES%, VOL.HDR%, FXD% = -1% & \ FILE.HDR%, VAR% = -2% & \ UN.HDR% = -3% & \ RANDOMIZE & 810 EOF% = NO% & \ DEBUG% = NO% & \ TAPE.DEV$ = 'MT0:' & \ TAPE.CHAN% = 1% & \ OUT.CHAN% = 2% & \ SEQ.NO% = 0% & \ IN.REC.TYPE% = FXD% & \ OUT.REC.TYPE% = FXD% & \ OMIT.CR% = NO% & 820 MAX.RECL% = 8480% ! (MUST BE MULTIPLE OF 512%) & 825 ! Set up the XLATE strings & 830 FOR I% = 1% TO 256% & \ READ A% & \ BCD$ = BCD$ + CHR$(A%) & \ NEXT I% & 831 DATA 0,0,0,0,0,0,0,0,0,0 832 DATA 0,0,0,0,0,0,0,0,0,0 833 DATA 0,0,0,0,0,0,0,0,0,0 834 DATA 0,0,0,0,0,0,0,0,0,0 835 DATA 0,0,0,0,0,0,0,0,0,0 836 DATA 0,0,0,0,0,0,0,0,0,0 837 DATA 0,0,0,0,32,0,0,0,0,0 838 DATA 0,0,0,0,0,46,41,91,60,0 839 DATA 43,0,0,0,0,0,0,0,0,0 840 DATA 0,36,42,93,59,0,45,47,0,0 841 DATA 0,0,0,0,0,0,0,44,40,0 842 DATA 92,0,0,0,0,0,0,0,0,0 843 DATA 0,0,32,61,39,58,62,0,0,97 844 DATA 0,0,0,0,0,0,0,0,0,0 845 DATA 0,0,0,0,0,0,0,0,0,0 846 DATA 0,0,0,0,0,0,0,0,0,0 847 DATA 0,0,0,0,0,0,0,0,0,0 848 DATA 0,0,0,0,0,0,0,0,0,0 849 DATA 0,0,0,0,0,0,0,0,0,0 850 DATA 0,0,63,65,66,67,68,69,70,71 851 DATA 72,73,0,0,0,0,0,0,33,74 852 DATA 75,76,77,78,79,80,81,82,0,0 853 DATA 0,0,0,0,0,0,83,84,85,86 854 DATA 87,88,89,90,0,0,0,0,0,0 855 DATA 48,49,50,51,52,53,54,55,56,57 856 DATA 0,0,0,0,0,0 & & 860 FOR I% = 1% TO 256% & \ READ A% & \ EBCDIC$ = EBCDIC$ + CHR$(A%) & \ NEXT I% & 870 DATA 0,1,2,3,0,9,0,127,0,0 871 DATA 0,11,12,13,14,15,16,17,18,0 872 DATA 0,0,8,0,24,25,0,0,0,0 873 DATA 0,0,0,0,28,0,0,10,23,27 874 DATA 0,0,0,0,0,0,5,6,7,0 875 DATA 22,0,0,30,0,4,0,0,0,0 876 DATA 20,21,0,26,32,0,0,0,0,0 877 DATA 0,0,0,0,0,46,60,40,43,124 878 DATA 38,0,0,0,0,0,0,0,0,0 879 DATA 33,36,42,41,59,94,45,47,0,0 880 DATA 0,0,0,0,0,0,0,44,37,95 881 DATA 62,63,0,0,0,0,0,0,0,0 882 DATA 0,96,58,35,64,39,61,34,0,97 883 DATA 98,99,100,101,102,103,104,105,0,0 884 DATA 0,0,0,0,0,106,107,108,109,110 885 DATA 111,112,113,114,0,0,0,0,0,0 886 DATA 0,126,115,116,117,118,119,120,121,122 887 DATA 0,0,0,91,0,0,0,0,0,0 888 DATA 0,0,0,0,0,0,0,0,0,93 889 DATA 0,0,123,65,66,67,68,69,70,71 890 DATA 72,73,0,0,0,0,0,0,125,74 891 DATA 75,76,77,78,79,80,81,82,0,0 892 DATA 0,0,0,0,92,0,83,84,85,86 893 DATA 87,88,89,90,0,0,0,0,0,0 894 DATA 48,49,50,51,52,53,54,55,56,57 895 DATA 125,0,0,0,0,0 & 897 ! EBCDIC is the default & XL$ = EBCDIC$ !XL$ is the XLATE string & \ ASCII.CODE% = NO% & 898 PRINT 'UNITAP 2.5 Tape Dumper' & 899 FNEND & 1100 DEF FNPARSE.CMD% & \ CMD$ = CVT$$(CMD$, 255%) & \ IF DEBUG% THEN PRINT 'Entering FNPARSE.CMD%' & 1110 IF CMD$ = 'ALL' OR LEFT(CMD$,1%) = '*' & THEN DSRD.FILE$ = '*' & \ OUT.FILE.ID$ = "" & \ GOTO 1190 & 1120 P1% = INSTR(1%, CMD$, '=') & \ IF P1% = 0% THEN OUT.FILE.ID$ = "" & ELSE OUT.FILE.ID$ = LEFT(CMD$, P1%-1%) & ! OUT.FILE.ID$ gets everything up to the '='. & 1140 P2% = INSTR(P1%, CMD$, '/') & \ IF P2% = 0% THEN P2% = LEN(CMD$)+1% 1145 DSRD.FILE$ = MID(CMD$, P1%+1%, P2%-P1%-1%) & ! DSRD.FILE$ gets everything from the '=' to & ! the '/' or to the end of CMD$. (This allows & ! for switches, which are implemented below.) & 1150 SLASH% = INSTR(P2%, CMD$, '/') & \ WHILE SLASH% & \ SWITCH$ = MID(CMD$, SLASH%+1%, 1%) & \ DELIM% = INSTR(SLASH%+1%, CMD$, '/') & \ DELIM% = LEN(CMD$) + 1% IF DELIM% = 0% & & \ N$ = MID(CMD$, SLASH%+3%, DELIM%-SLASH%-3%) & \ N% = VAL(N$) & & ! CASE-OF Structure follows: & & \ IF SWITCH$ = 'F' & THEN FIRST.N% = YES% & \ MAX.RECS% = N% & 1152 IF SWITCH$ = 'R' & THEN RNDM% = YES% & \ RNDM.FRAC% = N% & 1154 IF SWITCH$ = 'S' & THEN SPCL.SELECT% = YES% & \ JUNK% = FNSET.SELECT% & & ! End of CASE-OF Structure & 1156 SLASH% = INSTR(SLASH%+1%, CMD$, '/') & \ NEXT & & 1189 ! The two "recommended" forms of the command are: & ! & ! 1) outfil.nam = data.set.name & ! 2) outfil.nam = #nn & ! where nn = Data Set Number & ! (i.e. the nnTH data set on the tape) & ! The "outfil.nam =" may be omitted and a default will be generated. & 1190 IF DEBUG% THEN PRINT 'OUT.FILE.ID$ ='; OUT.FILE.ID$ & \ PRINT 'DSRD.FILE$ ='; DSRD.FILE$ & \ PRINT 'Leaving FNPARSE.CMD%' & 1199 FNEND & 1200 DEF FNDEBUG% 1201 IF DEBUG% = NO% & THEN DEBUG% = YES% & ELSE DEBUG% = NO% 1210 FNEND & & & 1300 DEF FNREWIND% & \ IF DEBUG% THEN PRINT 'Entering FNREWIND%' & 1310 CLOSE TAPE.CHAN% & \ OPEN TAPE.DEV$ AS FILE TAPE.CHAN%, RECORDSIZE MAX.RECL% & \ JUNK% = MAGTAPE(3%, 1%, TAPE.CHAN%) & \ CLOSE TAPE.CHAN% & \ JUNK% = FNLOAD% & 1390 IF DEBUG% THEN PRINT 'Leaving FNREWIND%' 1399 FNEND & & & 1400 DEF FNHELP% 1401 PRINT 'Commands:' 1402 PRINT ' LOAD Loads a tape and senses for Headers.' & \ PRINT ' SET Selects characteristics. If SET is not' & \ PRINT ' used, the default is IBM SL.' & \ PRINT ' DIR Prints a directory of the tape.' & \ PRINT ' REWIND Rewinds the tape and re-loads it.' & \ PRINT & \ PRINT ' outfil.ext = data.set.name For tapes with Headers.' & \ PRINT & \ PRINT ' outfil.ext = #n Dumps nTH dataset on tape,' & \ PRINT ' with/without Headers.' & \ PRINT & \ PRINT " If the 'outfil.ext =' is omitted, unique default" & \ PRINT ' output file-names are generated.' & \ PRINT & \ PRINT ' ALL Dumps all data.sets on tape.' & \ PRINT ' Generates unique default output file-names.' & \ PRINT & \ PRINT ' Switches may be appended to any file-request:' & \ PRINT ' /F:n Dumps only first N records in requested file.' & \ PRINT ' /R:n Dumps approx. N% of records in requested file.' & \ PRINT ' /S Enables special-selection criteria. User must' & \ PRINT ' code the selection routines. (See source listing)' & & 1499 FNEND & 1500 DEF FNDIR% & \ JUNK% = FNREWIND% & \ PASTE1$, PASTE2$ = "" & \ IF TAPE.TYPE% = UN.HDR% & THEN PASTE1$ = '#BLKS' & ELSE PASTE1$ = '#RECS' & \ PASTE2$ = 'CR-DATE' 1502 PRINT & \ PRINT TAB(4); 'NAME'; TAB(19); 'LRECL'; TAB(26); 'BLK-SZ'; TAB(34); & PASTE1$; TAB(42); PASTE2$ & 1505 IF (TAPE.TYPE% = VOL.HDR%) OR (TAPE.TYPE% = FILE.HDR%) & THEN DIR% = YES% & \ DSRD.FILE$ = '*' & \ JUNK% = FNHDR.TYPE% & 1510 IF TAPE.TYPE% = UN.HDR% & THEN DIR% = YES% & \ DSRD.FILE$ = '#32767' & \ JUNK% = FNNO.HDR.TYPE% & 1520 EOF% = NO% & \ JUNK% = FNREWIND% & \ DIR% = NO% 1599 FNEND & 1600 DEF FNSET.SELECT% & \ PRINT & \ PRINT 'Only null Select modules now exist.' & \ PRINT 'If you wish to enable selection, you must' & \ PRINT 'code two routines (within lines 1600-1699):' & \ PRINT & \ PRINT ' FNSET.SELECT% - (The routine which is currently' & \ PRINT ' printing this message.) Accepts user input' & \ PRINT ' and sets appropriate flags and variables.' & \ PRINT ' Be sure to eliminate this routine at line 1600.' & \ PRINT ' FNSELECT% - Actually performs the evaluation of the' & \ PRINT " of the user's citeria. Returns TRUE if selected;" & \ PRINT ' FALSE otherwise. Be sure to eliminate the dummy' & \ PRINT ' at line 1699.' & \ PRINT & \ PRINT 'Variables you will need:' & \ PRINT & \ PRINT ' OUT$ - Contains the current record, ready for output.' & \ PRINT ' (Trailing blanks included, translated to ASCII)' & \ PRINT & \ PRINT ' LRECL% - Logical Record Length' & \ PRINT & \ PRINT 'Please name all of your variables:' & \ PRINT ' S.name$' & \ PRINT ' S.name%' & \ PRINT & \ PRINT ' [ /S switch ignored; continuing ... ]' & \ PRINT & \ FNEND & & & 1699 DEF FNSELECT% = YES% & & & & & 1700 DEF FNGET.LRECL% & 1710 IF LOCK.LRECL% = YES% & THEN GOTO 1799 & ELSE INPUT 'LRECL'; LRECL% & \ IF DSRD.FILE$ = '*' & THEN & INPUT ' Lock this'; ANS$ & \ IF LEFT( CVT$$(ANS$,32%), 1% ) = 'Y' & THEN LOCK.LRECL% = YES% & 1799 FNEND & 30000 ! Main Error Routine & 30001 IF ERR <> 11 GOTO 30070 & 30005 IF ERL = 10 & THEN RESUME 32767 ! CTRL/Z to quit & 30010 IF ERL = 201 & THEN PRINT 'Empty tape' & \ RESUME 10 ! Back to 'Command' & 30020 IF ERL = 420 & THEN EOF% = YES% & \ RESUME 425 & 30030 IF ERL = 440 & THEN EOF% = YES% & \ RESUME 442 & 30040 IF ERL = 480 & THEN PRINT NUM.RECS; 'records written' UNLESS DIR% & \ PRINT THIS.FILE.ID$; TAB(20); LRECL%; TAB(26); & BLK.SIZE%; TAB(34); NUM.RECS; TAB(41); & CR.DATE$ IF DIR% & \ PRINT '(No TLR Blocks)' UNLESS DIR% & \ IF DSRD.FILE$ = '*' & THEN RESUME 420 & ELSE RESUME 490 & ! (This is to handle ANSI tapes with HDR's but no TLR's) & 30050 IF ERL = 501 & THEN EOF% = YES% & \ RESUME 510 & 30060 IF ERL=730 OR ERL=760 & THEN RESUME 762 & 30070 IF ERL=730 OR ERL=760 & THEN RESUME 762 & 30100 IF ERL > 1100 AND ERL < 1199 & THEN PRINT 'Switch error: Try again' & \ RESUME 10 & 30110 IF ERL = 406 OR ERL = 740 & THEN PRINT 'Switch error: Try again' & \ RESUME 10 & 30120 IF ERL = 410 & THEN PRINT 'Tape only contains'; DSN%-1%; 'datasets' & \ RESUME 490 & 30130 IF ERR=52 AND ERL=430 & THEN CR.DATE$ = '??-???-??' & \ RESUME 432 & 30200 ON ERROR GOTO 0 & & & 32767 END