2! PROGRAM : VMTAPE.BAS 5! VERSION : V1.0 6! EDIT : 00A 7! EDIT DATE : 11-Oct-86 10 EXTEND 11 ! & & & ! C O P Y R I G H T & & & ! Copyright (C) 1985, 1986 by Terence M. Kennedy & ! & ! & ! This software is furnished under a license and may be used and & ! copied only in accordance with the terms of such license and & ! with the inclusion of the above copyright notice. This & ! software or any other copies thereof may not be provided or & ! otherwise made available to any other person. No title to and & ! ownership of the software is hereby transferred. & ! & ! The information in this software is subject to change without & ! notice and should not be construed as a commitment by either & ! Terence M. Kennedy, Saint Peter's College, or Werner Associates. & ! & !******************************************************************* & & 20 ! & & & ! M O D I F I C A T I O N H I S T O R Y & & & ! VER/ED EDIT DATE REASON & ! 00-A 11-Oct-86 Original Version & & & 30 ! & & & ! V A R I A B L E U S A G E & & & ! VARIABLE USAGE & ! ABORT% Set to 1% on a fatal initialization error & ! ARG$ Command arguments (right part of REQ$) & ! ARG1%, ARG2% Dummy arguments to FNM% & ! CCLMODE% Set 0% if RUN, 1% if CCL , 2% if CCL & ! CMND$ Actual command (left part of REQ$) & ! CMPL% Set 0% if not complaining about bad CMS format & ! CMS.LBL$ CMS label at start of every record & ! CPU0 CPU time in seconds before operation & ! CPU1 CPU time in seconds after operation & ! DEC.FN$ DEC system filename to go to/from tape & ! DEL% Position of delimiter in command line & ! DF% Channel number DEC.FN$ is open on & ! DIG$ Temporary digit used in computing numeric parameters & ! DIR% Direction of tape movement (4%=fwd, 5%=bwd) & ! DK% Channel number disk file is open on & ! DUMMY$ Dummy return variable for SYS() functions & ! DUMMY Dummy real variable for CVT$% functions & ! EBC.ASC$ EBCDIC --> ASCII translation table & ! EOF% Set if EOF seen during a tape read & ! ERHD$ Error message header string "DMSTPE" & ! ERNO% RSTS/E error number & ! FILTYP$ Type of file, "F" for fixed, "V" for varaible & ! FUNC$(13%) List of valid command functions & ! HEX1$ String used in hex conversion (1 of 2) & ! HEX2$ String used in hex conversion (2 of 2) & ! I% General-purpose FOR/NEXT control variable & ! I.FN$ IBM filename from user command & ! I.FT$ IBM filetype from user command & ! I.FM$ IBM filemode from user command & ! J% General-purpose return variable from MAGTAPE() & ! KB% Channel number user's KB is open on & ! KWD$ Single option keyword from ARG$ & ! LEGAL$ List of legal characters in DEC filenames (XLATE) & ! LPNAM$ Name of line printer to spool to & ! LRECL Length of longest record in CMS file & ! MAG.TMP$ FIELDed raw I/O data from/to magtape unit & ! MAG.IN$ Translated MAG.TMP$ truncated to record length & ! MAG.DAT$ Temporary string for EBCDIC/ASCII/EBCDIC xlates & ! MAG.VOL$ Magtape volume ID & ! MT% Channel number tape unit is open on & ! NBLOCKS Number of blocks read from tape file & ! NRECS Number of blocks that should be on tape file & ! OD% Output device number for PRINT, TERM, DISK options & ! OPT%(7%) Option matrix for routines w/ options & ! QUAN% Number of records/files/tapemarks to do & ! REC% Copy of system variable RECOUNT & ! REDIR% Flag for redirection in progress & ! REQ$ User request string from prompt & ! RETC% Return code from an operation & ! T,T1,T2,T3 Used in FNT$ to return the time & ! TIOM% Tape I/O mode for error reporting (0%=read, 1%=write) & ! TMODE% Mode of RSTS/E tape unit TUNIT$ & ! TUNIT$ Name of RSTS/E tape unit to use & ! T.FN$ IBM filename from tape & ! T.FT$ IBM filetype from tape & ! T.FM$ IBM filemode from tape & ! TF% Channel number WFILE$ is opened on for conversion & ! UFLAG% Set nonzero if file had untranslatable chars. in it & ! UPA$ Character to replace EBCDIC unprintables with in ASCII & ! UPA% Decimal code of UPA$, used in XLATE string building & ! UPE$ Character to replace ASCII unprintables with in EBCDIC & ! UPE% Decimal code of UPE$, used in XLATE string building & ! WFILE$ Name of workfile for LOAD & & & 99 ! Entry point if "RUN" & & cclmode%=0% ! Indicate not in CCL mode 100 ! Common entry point whether "RUN" or CCL entry & & abort%=0% ! So far, no fatal errors & \ dim func$(13%) ! There are 13 functions & \ func$(1%)="DUMP" ! Dump files to CMS tape & \ func$(2%)="LOAD" ! Load files from CMS tape & \ func$(3%)="SCAN" ! Print a list of files on CMS tape & \ func$(4%)="SKIP" ! Bypass files on CMS tape & \ func$(5%)="DVOL1" ! Display VOL1 label & \ func$(6%)="WVOL1" ! Write VOL1 label & \ func$(7%)="BSF" ! Backspace file & \ func$(8%)="BSR" ! Backspace record & \ func$(9%)="FSF" ! Foreward space file & \ func$(10%)="FSR" ! Foreward space record & \ func$(11%)="REW" ! Rewind tape, no unload & \ func$(12%)="RUN" ! Rewind & unload tape & \ func$(13%)="WTM" ! Write tape mark & \ dim opt%(7%) ! There are 7 options for file cmnds. & \ erhd$="DMSTPE" ! Error message prefix & \ upa$=chr$(25%) ! Replace EBCDIC unprintables with ^Y & \ upe$=chr$(63%) ! Same, for ASCII (VM prints as ") & \ cms.lbl$=chr$(2%)+chr$(195%)+ & chr$(212%)+chr$(226%)! CMS label header in EBCDIC & \ tunit$="MS0:" ! Name of tape unit & \ tmode%=256% ! 1600 BPI tape & \ lpnam$="LP"+chr$(0%)+chr$(255%) ! Name of printer device (LP0:) & \ mt%=8% ! Magtape unit number & \ kb%=9% ! Console terminal unit number & \ dk%=10% ! Disk file unit number (for logfile) & \ df%=11% ! Disk file unit number (for data) & \ tf%=12% ! Disk file unit number (for temp) & \ gosub 32300 ! Set up error traps & \ cpu0=fnc ! In case no tape drive 110 open tunit$ as file mt%, recordsize 8192%, mode tmode% ! ERL=110 & \ field #mt%, 8192% as mag.tmp$ ! FIELD into buffer string & \ gosub 32310 ! Set ^C trap 120 gosub 30400 ! Set up EBCDIC-->ASCII table 130 gosub 30500 ! Set up ASCII-->EBCDIC table & 200 ! Main prompt and function decoding & & cpu0=fnc ! Get start CPU time & \ retc%=0% ! Default to no error condition & \ if cclmode%=1% then goto 220 ! If entered via CCL & else print #kb%,"VMTAPE>"; ! Print prompt 210 input line #kb%,req$ ! Get request string 220 req$=cvt$$(req$,1%+4%+8%+16%+32%+128%)! Edit string per User's Manual & \ req$=req$+" " ! Hang one space on end & \ if req$=" " then goto 200 ! If null input, loop 230 del%=instr(1%,req$," ") ! Find delim. between comm. and args. & \ cmnd$=mid(req$,1%,del%-1%) ! Strip out command code to CMND$ & \ arg$=mid(req$,del%+1%,len(req$)) ! And get (optional) args. to ARG$ & \ for i%=1% to 13% ! Loookup function by number & \ if func$(i%)=cmnd$ then goto 250 ! If desired function found 240 next i% ! Else do next posibility & \ print #kb%,erhd$;"014E Invalid function '";cmnd$;"'." & \ retc%=24% & \ goto 300 ! At end, give error message and loop 250 on i% goto 1000,2000,3000,4000, ! Go to proper routine for function & 5000,6000,7000,8000,9000,10000, & 11000,12000,13000 300 ! Print return code (RETC%) if non-zero, CPU/Device time, loop & & print #kb%,"R"; ! Print VM ready prompt & \ if retc%=0% then goto 320 ! If zero, don't print RC 310 print #kb%,"("; & \ print #kb%,string$(5%-len(num1$(retc%)),48%); & num1$(retc%);")"; ! Print RC 0-filled[5] 320 print #kb%,"; T="; ! Prepare to print CPU usage & \ cpu1=fnc ! Get current CPU usage & \ if cpu1-cpu0=0% then dummy$="0.03" else & dummy$=num1$((cpu1-cpu0)/10.)+"0" ! CPU usage in seconds 330 print #kb%,dummy$;"/";dummy$; ! Print it & \ print #kb%," ";fnt$ ! Print time in system format & \ if redir%<>0% then gosub 30300! Close I/O redirection if open 340 if cclmode%=1% then goto 32767 ! Exit if in CCL mode & else if abort%<>1% then goto 200! And go re-prompt unless fatal & else goto 32767 ! Else exit & 1000 ! DUMP Function & & ! 1000-1099 - Setup routine, print header, do file lookup & & ! *** Later on, we need to suport device names in here, too & ! *** Also, we need to support logicals and PPN's - they are & ! *** accepted by the parser but are eaten before conversion into & ! *** DEC.FN$. Also, we probably want to do something about files & ! *** which are not useful like .TSK's. Also, we need to trap write & ! *** errors at 29000, and pad short blocks so we don't get Illegal & ! *** byte count for I/O or whatever it is. & tiom%=1% ! Say writing & \ gosub 20200 ! Set up the option string 1010 gosub 30200 ! Set up the output device & \ print #od%," Dumping...." ! Print header & \ index%=0% ! Start with first file & \ dummy$=sys(chr$(6%)+chr$(-10%) ! Do FSS, ERL=1030 & +i.fn$+"."+i.ft$+chr$(0%)) 1020 dec.fn$=sys(chr$(6%)+chr$(17%)+chr$(index%) ! Lookup by index & +chr$(swap%(index%))+mid(dummy$,5%,12%) ! ERL=1040 & +string$(10%,0%)) & \ dec.fn$=rad$(swap%(cvt$%(mid(dec.fn$,7%,8%))))+ ! Convert to ASCII & rad$(swap%(cvt$%(mid(dec.fn$,9%,10%)))) + & "."+rad$(swap%(cvt$%(mid(dec.fn$,11%,12%)))) & \ print #od%," "+dec.fn$; ! Display it for the masses & \ gosub 1100 ! Do the actual processing & \ index%=index%+1% ! And do next file & \ goto 1020 1030 print #kb%,"DMSSTT062E Invalid character in fileid '";i.fn$;" "; & i.ft$;" ";i.fm$;"'." & \ retc%=20% & \ goto 300 ! Say bad filename, exit 1040 if index%<>0% then goto 1050 ! If we did some files, go quietly & else print #kb%,erhd$;"002E File(s) '";i.fn$;" ";i.ft$;" "; & i.fm$;"' not found." & \ retc%=28% & \ goto 300 ! Say no files matched specifier 1050 gosub 30300 ! Close redirection & \ goto 300 ! And exit & 1100 ! 1100-1199 - Open DEC.FN$ and put it on the tape & & open dec.fn$ for input as file #df% ! Open file up & \ nrecs=0% ! Initially no data & \ nblocks=0% ! And no tape blocks written & \ lrecl=0% ! And short record 1110 mag.in$=cms.lbl$+chr$(229%) ! Prepare the string 1120 input line #df%,mag.dat$ ! Get an input line, ERL=1200 & \ mag.dat$=left(mag.dat$,len(mag.dat$)-2%) ! Trim off return & \ if len(mag.dat$)=0% then mag.dat$=" " ! Ensure line for IBM 1125 if len(mag.dat$)>lrecl then lrecl=len(mag.dat$) ! Update max length 1130 mag.in$=mag.in$+cvt%$(len(mag.dat$)) & +xlate(mag.dat$,asc.ebc$) ! Add into string & \ nrecs=nrecs+1% ! Say another record written & \ if len(mag.in$)chr$(229%) then & if left(mag.dat$,1%)<>chr$(198%) then goto 28030 ! If not a legal format 2060 mag.dat$=mid(mag.dat$,2%,len(mag.dat$)) ! Get the EBCDIC part & \ print #df%,mag.dat$; ! And write to disk temp file & \ cmpl%=1% ! Complain about bad CMS format & \ gosub 28100 ! Get a translated record from tape & \ goto 2040 ! Loop until done with file 2070 cmpl%=1% ! Complain about non-CMS format & \ gosub 28100 ! Get another record & \ print #od%," END-OF-FILE OR END-OF-TAPE" & \ if eof%=1% then goto 2080 ! If two TM's in a row & else opt%(4%)=opt%(4%)-1% ! One less file to do & \ if opt%(4%)=0% then goto 2090 ! If done & else goto 2040 ! Else go round again 2080 print #od%," LOGICAL END-OF-TAPE" 2090 gosub 30300 ! Turn off output redirection & \ goto 300 ! All done, exit & 2100 & ! 2100-2199 - Enter here when filename block is found, see if & ! user wants it loaded, handle wildcards, convert & ! name to DEC style, call for file data conversion. & & t.fn$=xlate(mid(mag.dat$,66%,8%),ebc.asc$) ! Tape name & \ t.ft$=xlate(mid(mag.dat$,74%,8%),ebc.asc$) ! Tape type & \ t.fm$=xlate(mid(mag.dat$,82%,2%),ebc.asc$) ! Tape mode & \ uflag%=0% ! Initially no unprintable characters & \ nrecs=cvt$%(mid(mag.dat$,36%,2%)) ! Get nrecs & \ if nrecs<0% then nrecs=65536.0+nrecs ! If negative, wrap it 2102 nrecs=nrecs+(asc(mid(mag.dat$,35%,1%))*65536.0) ! Do high order byte too 2105 lrecl=cvt$%(mid(mag.dat$,16%,2%)) ! Get lrecl & \ if lrecl<0% then lrecl=65536.0+lrecl ! If negative, wrap it 2110 if i.fn$<>"*" then & if i.fn$<>t.fn$ then goto 2180 ! If unambiguous mismatch, skip 2120 if i.ft$<>"*" then & if i.ft$<>t.ft$ then goto 2180 ! Same here 2130 dec.fn$=left(xlate(t.fn$,legal$),6%)+"." & +left(xlate(t.ft$,legal$),3%) ! Create legal, unique DEC filename & \ if opt%(7%)=0% then goto 2140 ! If not asking about each file & else print #kb%," ";t.fn$;" ";t.ft$;" ";t.fm$;"? "; & \ input #kb%,dummy$ ! Else print name and ask if wanted & \ if left(cvt$$(dummy$,39%),1%)<>"Y" then goto 2180 ! If unwanted 2140 repl$=" " ! Default to noreplace & \ kill dec.fn$ ! Delete old, ERL=2140 & \ repl$=" (Replaced)" ! Say replaced 2150 close #df% ! Close disk file & \ print #od%," ";t.fn$;" ";t.ft$;" ";t.fm$; ! Tell user CMS name & \ gosub 2200 ! Convert data, etc & \ print #od%," as ";dec.fn$;repl$; & \ if uflag%<>0% then print #od%," untranslatable character(s) in file" & else print #od%," " 2160 if (i.fn$="*" or i.ft$="*") then goto 2020 ! Not a stopper, cont. 2170 gosub 30300 ! Turn off output redirection & \ goto 300 ! All done, exit 2180 close #df% ! Close temporary file & \ kill wfile$ ! And delete it & \ goto 2020 ! Then loop to next file & 2200 & ! 2200-2399 - Convert the data in raw workfile to DEC format, count & ! untranslatable characters, etc. & & open wfile$ for input as file #df% ! Open input & \ open dec.fn$ for output as file #tf% ! And output & \ nblocks=0% ! Initially no blocks written & \ if filtyp$="F" then goto 2300 ! If file is fixed format 2220 field #df%, 512% as mag.dat$ ! Set up buffer & \ get #df% ! Get the EBCDIC data 2230 dummy=cvt$%(left(mag.dat$,2%))! Get length of this record & \ if dummy<0% then dummy=dummy+65536.0 ! If negative, wrap it 2240 mag.dat$=mid(mag.dat$,3%,len(mag.dat$)) ! Strip length bytes 2250 if dummy<=len(mag.dat$) then goto 2260 ! If record fits in string & else dummy$=xlate(mag.dat$,ebc.asc$) ! Convert to ASCII & \ print #tf%,dummy$; ! Write out this part & \ uflag%=fnu%(dummy$) ! See if unprintables & \ dummy=dummy-len(mag.dat$) ! Account for these bytes & \ field #df%, 512% as mag.dat$ ! Re-buffer it & \ get #df% ! Get next block & \ goto 2250 ! And process it 2260 dummy$=xlate(left(mag.dat$,dummy),ebc.asc$) ! Convert to ASCII & \ print #tf%,dummy$ ! Write out rest & \ uflag%=fnu%(dummy$) ! See if unprintable & \ nblocks=nblocks+1% ! Increment block counter & \ if nblocks=nrecs then goto 2400 ! If all done 2270 mag.dat$=mid(mag.dat$,dummy+1%,len(mag.dat$)) ! Remove from source & \ if len(mag.dat$)>=2% then goto 2230 ! If enough for a length, ok & else dummy$=mag.dat$ ! Else hold these & \ field #df%, 512% as mag.dat$ ! Re-buffer it & \ get #df% ! Get some more & \ mag.dat$=dummy$+mag.dat$ ! Make a new, usable string & \ goto 2230 ! And process the rest & 2300 field #df%, 512% as mag.dat$ ! Set up buffer & \ get #df% ! Get the EBCDIC data 2310 dummy=lrecl ! Copy of LRECL for operations 2320 if dummy<=len(mag.dat$) then goto 2330 ! If record fits in string & else dummy$=xlate(mag.dat$,ebc.asc$) ! Convert to ASCII & \ print #tf%,dummy$; ! Write out this part & \ uflag%=fnu%(dummy$) ! See if unprintable & \ dummy=dummy-len(mag.dat$) ! Account for these bytes & \ field #df%, 512% as mag.dat$ ! Re-buffer it & \ get #df% ! Get next block & \ goto 2320 ! And process it 2330 dummy$=xlate(left(mag.dat$,dummy),ebc.asc$) ! Convert to ASCII & \ print #tf%,dummy$ ! Write out rest & \ uflag%=fnu%(dummy$) ! See if unprintable & \ nblocks=nblocks+1% ! Increment block counter & \ if nblocks=nrecs then goto 2400 ! If all done 2340 mag.dat$=mid(mag.dat$,dummy+1%,len(mag.dat$)) ! Remove from source & \ goto 2310 ! And process the rest & 2400 close #df% ! Close input file & \ close #tf% ! And output file & \ return ! And exit & 3000 ! SCAN Function & & tiom%=0% ! Say reading & \ gosub 20200 ! Set up the option string 3010 gosub 30200 ! Set up the output device & \ print #od%," Scanning...." ! Print header & \ if opt%(6%)<>1% then goto 3015! If not long format scan & else print #od%," Filename Filetype FM Format Lrecl Records "; & "Date Time" ! Print full header lines & \ print #od%," -------- -------- -- ------ ----- ---------- "; & "-------- --------" 3015 nblocks=0% ! Say no blocks in file yet 3020 cmpl%=1% ! Complain about bad tape format & \ gosub 28000 ! Get a translated record from tape 3030 nblocks=nblocks+1% ! Say file has one more block in it & \ if eof%=1% then goto 3060 ! If EOF was detected & else if left(mag.in$,1%)<>"N" then goto 3020 3040 t.fn$=mid(mag.in$,66%,8%) ! Tape name & \ t.ft$=mid(mag.in$,74%,8%) ! Tape type & \ t.fm$=mid(mag.in$,82%,2%) ! Tape mode & \ if i.fn$<>"*" then & if i.fn$<>t.fn$ then goto 3015 ! If unambiguous mismatch, skip 3042 if i.ft$<>"*" then & if i.ft$<>t.ft$ then goto 3015 ! Same here 3045 print #od%," ";t.fn$;" ";t.ft$; & " ";t.fm$; ! Print short form entry & \ if opt%(6%)=1% then goto 3050 ! Continue if doing long form & else print #od%,"" ! Else end line & \ goto 3080 ! And loop 3050 print #od%," ";mid(mag.in$,12%,1%); & " "; ! Print recfm & \ dummy=cvt$%(mid(mag.dat$,20%,2%)) ! Get recl & \ if dummy<0% then dummy=65536.0+dummy ! If negative, wrap it 3052 print #od% using "######",dummy; & \ print #od%," "; ! And recl & \ dummy=cvt$%(mid(mag.dat$,40%,2%)) ! Get nrecs & \ if dummy<0% then dummy=65536.0+dummy ! If negative, wrap it 3053 dummy=dummy+(asc(mid(mag.dat$,39%,1%))*65536.0) ! Do high byte too 3054 print #od% using "#######",dummy; & \ print #od%," ";fnh$(mid(mag.dat$,45%,1%));"/"; & fnh$(mid(mag.dat$,46%,1%));"/"; & fnh$(mid(mag.dat$,44%,1%));" "; ! Print date as MM/DD/YY & fnh$(mid(mag.dat$,47%,1%));":"; & fnh$(mid(mag.dat$,48%,1%));":"; & "00" ! Print time as HH:MM:00 & \ goto 3080 ! And loop 3060 cmpl%=1% ! Complain about non-CMS format & \ gosub 28000 ! Get another record & \ print #od%," END-OF-FILE OR END-OF-TAPE" & \ if eof%=1% then goto 3070 ! If two TM's in a row & else opt%(4%)=opt%(4%)-1% ! One less file to do & \ if opt%(4%)=0% then goto 3075 ! If done & else goto 3030 ! Else go round again 3070 print #od%," LOGICAL END-OF-TAPE" 3075 gosub 30300 ! Turn off output redirection & \ goto 300 ! All done, exit 3080 if (i.fn$="*" or i.ft$="*") then goto 3015 ! Not a stopper, cont. 3090 j%=magtape(5%,nblocks+1%,mt%) ! Backspace to previous name block & \ if j%<>0% then goto 3110 ! If hit reflector or TM & else cmpl%=1% ! Complain about bad CMS format & \ gosub 28000 ! Get translated record from tape 3100 if eof%=1% then goto 3110 ! If EOF, stop here & else if mid(mag.in$,1%,1%)<>"N" then goto 32766 ! Panic on bad position 3110 gosub 30300 ! Turn off output redirection 3120 goto 300 ! When done & 4000 ! SKIP Function 5000 ! DVOL1 Function & & tiom%=0% ! Say reading & \ gosub 20200 ! Set up the option string 5010 j%=magtape(3%,0%,mt%) ! First, rewind the tape & \ cmpl%=0% ! Don't complain about bad CMS format & \ gosub 28000 ! Get a translated record from tape 5020 mag.vol$=mag.in$ ! Save as temporary volume label & \ if len(mag.vol$)<>80% then goto 25000 5030 if left(mag.vol$,4%)<>"VOL1" then goto 25000 5080 print #kb%,left(mag.vol$,79%) ! If all is ok, display VOLID & \ if opt%(5%)=1% then goto 300 ! Prompt user for next oper. if LEAVE 5090 j%=magtape(3%,0%,mt%) ! Else rewind the tape & \ goto 300 ! And exit & 6000 ! WVOL1 Function & & tiom%=1% ! Say writing & \ gosub 20200 ! Set up the option string & \ if i.fn$="*" then i.fn$="" ! Fixup for parser 6005 if i.ft$="*" then i.ft$="" ! Likewise 6010 j%=magtape(3%,0%,mt%) ! First, rewind the tape & \ dig$=i.fn$ ! Preset for error 029E just in case & \ kwd$="WVOL1" ! Likewise & \ if len(i.fn$)>6% then goto 26000 ! If he blew it (name too long) & else if i.fn$="" then goto 26000! Likewise, but name too short 6020 dig$=i.ft$ ! Preset for error 029E just in case & \ if len(i.ft$)>8% then goto 26000 ! If he blew it (name too long) & else mag.in$="VOL1"+i.fn$+space$(6%-len(i.fn$))+"0"+space$(30%) & \ mag.in$=mag.in$+i.ft$+space$(39%-len(i.ft$)) ! Built VOL1 record & \ mag.dat$=xlate(mag.in$,asc.ebc$) ! Make EBCDIC of it & \ gosub 29000 ! Write it out 6030 mag.in$="HDR1"+string$(76%,48%) ! Built HDR1 record & \ mag.dat$=xlate(mag.in$,asc.ebc$) ! Make EBCDIC of it & \ gosub 29000 ! Write it out 6040 j%=magtape(2%,0%,mt%) ! Drop a tape mark, too & \ j%=magtape(2%,0%,mt%) ! Rewind the tape & \ if opt%(5%)=0% then goto 300 ! Prompt user for next oper. if (REWIND 5090 j%=magtape(4%,1%,mt%) ! Else FSR the tape & \ goto 300 ! And exit & 7000 ! BSF Function & & tiom%=0% ! Say reading & \ dir%=5% ! Set direction=backwards & \ gosub 20100 ! Get a single numeric option 7010 for i%=1% to quan% ! How many files to space 7020 j%=magtape(dir%,32767%,mt%) ! Skip maximum records possible & \ j%=magtape(7%,0%,mt%) ! Get tape status & \ if j% and 256% goto 8020 ! If hit BOT reflector 7030 if j% and 128% goto 7050 ! If hit tape mark 7040 goto 7020 ! Else go skip some more 7050 next i% ! Loop on next file & \ goto 300 ! And go prompt user for next oper. & 8000 ! BSR Function & & tiom%=0% ! Say reading & \ dir%=5% ! Set direction=backwards & \ gosub 20100 ! Get a single numeric option 8010 j%=magtape(dir%,quan%,mt%) ! F/B space QUAN% records (unless TM) & \ if j%=0% then goto 300 ! Good completion 8020 print #kb%,erhd$;"058E End-of-file or end-of tape." & \ retc%=40% & \ goto 300 ! And go prompt user for next oper. & 9000 ! FSF Function & & tiom%=0% ! Say reading & \ dir%=4% ! Set direction=forewards & \ gosub 20100 ! Get a single numeric option 9010 goto 7010 ! And use common code W/ backspace & 10000 ! FSR Function & & tiom%=0% ! Say reading & \ dir%=4% ! Set direction=forewards & \ gosub 20100 ! Get a single numeric option 10010 goto 8010 ! And use common code W/ backspace & 11000 ! REW Function & & tiom%=0% ! Say reading & \ gosub 20000 ! Ensure no options given 11010 j%=magtape(3%,0%,mt%) ! Normal rewind operation & \ goto 300 ! And go prompt user for next oper. & 12000 ! RUN Function & & tiom%=0% ! Say reading & \ gosub 20000 ! Ensure no options given 12010 j%=magtape(1%,0%,mt%) ! Rewind and offline operation & \ goto 300 ! And go prompt user for next oper. & 13000 ! WTM Function & & tiom%=1% ! Say writing & \ gosub 20100 ! Get a single numeric option 13010 for i%=1% to quan% ! Set up loop to write QUAN% tapemarks & \ j%=magtape(2%,0%,mt%) ! ERL=13010 Write tape mark operation & \ next i% & \ goto 300 ! And go prompt user for next oper. 20000 ! Subroutine to ensure the optional argument string is blank & & if arg$="" then return ! If null, all is well 20020 print #kb%,erhd$;"003E Invalid option '";arg$;"'." & \ retc%=24% & \ goto 300 & 20100 ! Subroutine to get a single numeric argument and return as QUAN% & & if arg$="" then quan%=1% ! If nothing given, default to 1 & \ return ! And exit 20110 quan%=val(arg$) ! ERL=20110 & \ if quan%=0% then goto 20020 ! Can't have a zero count option 20120 return & 20200 ! Subroutine to handle complex option strings and return in OPT%() & & opt%(1%)=1% ! OPTIONA 0=WTM, 1=NOWTM & \ opt%(2%)=4096% ! OPTIONA BLKSIZE & \ opt%(3%)=1% ! OPTIONB 0=PRINT, 1=TERM, 2=DISK & \ opt%(4%)=1% ! OPTIONC 1=EOF 1, 2=EOF 2, etc. & \ opt%(5%)=1% ! OPTIONE 0=REWIND, 1=LEAVE & \ opt%(6%)=0% ! OPTIONF 0=SHORT, 1=FULL & \ opt%(7%)=0% ! OPTIONG 0=NOQUERY, 1=QUERY & \ i.fn$="*" ! Default to all & \ i.ft$="*" ! Same here & \ i.fm$="A" ! Default to A disk & ! Defaults set, now look and see if anything given 20210 if arg$="" then return ! If nothing given, exit & else if left(arg$,1%)="(" then goto 20240 ! If hit options, go do 'em 20220 if left(arg$,1%)<>" " then goto 20330 ! If hit filename stuff 20230 arg$=mid(arg$,2%,len(arg$)) ! Truncate space, iterate & \ goto 20210 20240 ! Handle option keywords & arg$=mid(arg$,2%,len(arg$)) ! Remove leading parenthesis & \ del%=instr(1%,arg$,")") ! Do we have a closing paren? & \ if del%<>0% then arg$=left(arg$,del%-1%) ! strip paren 20250 arg$=arg$+" " ! Force a trailing space 20260 del%=instr(1%,arg$," ") ! Grab a keyword & \ kwd$=mid(arg$,1%,del%-1%) ! Into KWD$ & \ arg$=mid(arg$,del%+1%,len(arg$)) ! remove from input string 20270 if (kwd$="WTM" and cmnd$="DUMP") then opt%(1%)=0% & else if (kwd$="NOWTM" and cmnd$="DUMP") then opt%(1%)=1% & else if (kwd$="BLKSIZE" and cmnd$="DUMP") then goto 20290 & else if left(kwd$,2%)="PR" then opt%(3%)=0% & else if left(kwd$,2%)="TE" then opt%(3%)=1% & else if kwd$="DISK" then opt%(3%)=2% & else if kwd$="EOT" then opt%(4%)=32767% & else if kwd$="EOF" then goto 20310 & else if kwd$="REWIND" then opt%(5%)=0% & else if kwd$="LEAVE" then opt%(5%)=1% & else if kwd$="SHORT" then opt%(6%)=0% & else if kwd$="LONG" then opt%(6%)=1% & else if left(kwd$,4%)="NOQU" then opt%(7%)=0% & else if left(kwd$,2%)="QU" then opt%(7%)=1% & else arg$=kwd$ ! Just show him the bad keyword & \ goto 20020 ! If no good, complain 20280 if arg$=space$(len(arg$)) then return & else goto 20260 ! Go do next keyword if more left 20290 ! Get parameter for BLKSIZE option (only 800 or 4096) & del%=instr(1%,arg$," ") ! Look for a numeric & \ dig$=mid(arg$,1%,del%-1%) ! Into DIG$ & \ if dig$="800" then opt%(2%)=800% & else if dig$="4096" then opt%(2%)=4096% & else goto 26000 ! If not valid, complain 20300 arg$=mid(arg$,del%+1%,len(arg$))! Remove the parameter & \ goto 20280 ! And continue processing 20310 ! Get parameter for EOF option (any numeric up to 32767) & del%=instr(1%,arg$," ") ! Look for a numeric & \ dig$=mid(arg$,1%,del%-1%) ! Into DIG$ & \ if dig$="" then opt%(4%)=1% ! If omitted & else opt%(4%)=val(dig$) ! ERL=20310 20320 goto 20300 ! Remove and continue 20330 ! Get a filename into I.FN,FT,FM$ & del%=instr(1%,arg$," ") ! Locate delimiter & \ if del%<>0% then goto 20350 ! If got one 20340 print #kb%,erhd$;"023E No filetype specified." & \ retc%=24% & \ goto 300 20350 i.fn$=cvt$$(mid(arg$,1%,del%-1%),1%+32%) ! Get filename to I.FN$ & \ arg$=mid(arg$,del%,len(arg$)) ! Lop it off & \ gosub 20800 ! Kill leading spaces 20355 del%=fnm%(instr(1%,arg$," "),instr(1%,arg$,"(")) ! Look for filetype & \ if del%<>0% then goto 20370 ! Found a delimiter, go for it 20360 if cmnd$="WVOL1" then goto 20375! If WVOL1, filetype not mandatory & else goto 20340 ! Didn't have filetype after all 20370 if left(arg$,1%)="(" then goto 20340 ! If no text before option & else i.ft$=cvt$$(mid(arg$,1%,del%-1%),1%+32%) ! Get filetype to I.FT$ & \ arg$=mid(arg$,del%,len(arg$)) ! Lop it off & \ gosub 20800 ! Kill leading spaces 20375 if mid(arg$,1%,1%)="(" then goto 20210 ! If no space (and no FM) 20380 del%=fnm%(instr(1%,arg$," "),instr(1%,arg$,"(")) ! Look for filemode & \ if del%<>0% then dummy$=mid(arg$,1%,del%-1%) & \ goto 20400 ! Found a delimiter, go for it 20390 goto 20210 ! Didn't have one, exit 20400 if cmnd$="DUMP" or cmnd$="LOAD" then goto 20410 ! If mode allowed & else print #kb%,erhd$;"070E Invalid parameter '";dummy$;"'." ! Error & \ retc%=24% & \ goto 300 20410 dummy$=cvt$$(left(arg$,1%),1%+32%) ! Letter of filemode & \ if dummy$<"A" then goto 20440 ! Bad letter (too low) & else if dummy$>"Z" then goto 20440 ! Bad letter (too high) & else i.fm$=dummy$ ! Else set mode & \ arg$=mid(arg$,2%,len(arg$)) ! And trim from input string 20420 dummy$=cvt$$(left(arg$,1%),1%+32%) ! Number of filetype or delim. & \ if dummy$=" " then return ! If null & else if dummy$="(" then return ! Likewise 20430 i.fm$=i.fm$+dummy$ ! Append and presume Ok & \ if dummy$<"0" then goto 20435 ! Bad number (too low) & else if dummy$>"6" then goto 20435 ! Bad number (too high) & else return ! If good number 20435 dummy$=i.fm$ ! What we are complaining about 20440 print #kb%,"DMSSTT048E Invalid mode '";dummy$;"'." ! Error & \ retc%=24% & \ goto 300 20800 ! Routine to lop leading spaces off ARG$ & if len(arg$)=0% then return ! If null string & else if left(arg$,1%)<>" " then return ! If all done & else arg$=mid(arg$,2%,len(arg$))! Else lop off leading space & \ goto 20800 ! And loop 22000 ! Routine to complain about write-protected tape drive & & print #kb%,erhd$;"043E 'TAP1(";tunit$;")' is file protected." & \ retc%=36% & \ goto 300 & 23000 ! Routine to complain about busy or non-existant tape drive & & print #kb%,erhd$;"113S TAP1(";tunit$;") is not attached." & \ retc%=100% & \ abort%=1% ! Set abort flag & \ goto 300 & 24000 ! Routine to complain about I/O errors on tape drive & ! TIOM%=0% for a read, 1% for a write & & print #kb%,erhd$; ! Message header & \ if tiom%<>0% then goto 24020 ! If not reading 24010 print #kb%,"110S Error reading"; & \ goto 24030 ! Go use common code 24020 print #kb%,"111S Error writing"; 24030 print #kb%," 'TAP1(";tunit$;")'." ! Tail of message & \ retc%=100% & \ goto 300 & 25000 ! Routine to complain about bad VOL1 on tape file & & print #kb%,erhd$;"431E 'TAP1(";tunit$;")' VOL1 label missing." & \ retc%=32% & \ goto 300 & 26000 ! Routine to complain about bad parameters & & print #kb%,erhd$;"029E Invalid parameter '";dig$;"' in the option '"; & kwd$;"' field." & \ retc%=24% & \ goto 300 & 28000 ! Get a record fron the tape, return xlated data in MAG.IN$, raw data & ! in MAG.DAT$, check for proper CMS record type and/or EOF if desired & & gosub 28500 ! Do the actual raw read 28010 mag.dat$=left(mag.tmp$,rec%) ! Trim to size and translate & \ mag.in$=xlate(mag.dat$,ebc.asc$) & \ if left(mag.dat$,4%)=cms.lbl$ then goto 28040 28020 if cmpl%=0% then return ! If not complaining about bad format 28030 print #kb%,erhd$;"057E Invalid record format." & \ retc%=32% & \ goto 300 ! If good type, return, else error 28040 mag.in$=mid(mag.in$,5%,len(mag.in$)) & \ return ! Send it back 28050 eof%=1% ! Signal EOF as seen & \ return ! And exit & 28100 ! As 28000, but don't bother XLATEing the data, and strip off the 2CMS & & gosub 28500 ! Do the actual raw read & \ mag.dat$=left(mag.tmp$,rec%) ! Trim to size & \ if left(mag.dat$,4%)=cms.lbl$ then goto 28120 28110 if cmpl%=0% then return ! If not complaining about bad format & else goto 28030 28120 mag.dat$=mid(mag.dat$,5%,len(mag.dat$)) & \ return & 28500 ! Get a raw record from the tape and return in MAG.TMP$, valid length & ! in REC% & & eof%=0% ! Initially no EOF seen & \ get #mt% ! Read the record & \ rec%=recount ! Get actual length & \ return ! And exit 28510 eof%=1% ! Signal EOF as seen & \ return ! And exit & 29000 ! Write a raw record to the tape from MAG.DAT$ & & eof%=0% ! Initially no EOF seen & \ lset mag.tmp$=mag.dat$ ! Stuff into the buffer & \ rec%=len(mag.dat$) ! Determine the correct length & \ put #mt%, count rec% ! write it out & \ return ! And exit 29010 eof%=1% ! Signal EOF as seen & \ return ! And exit & 30000 ! CCL entry point & & req$=sys(chr$(7%)) ! Get core common & \ dummy=instr(1%,req$," ") ! Was an argument typed? & \ if dummy=0% then cclmode%=2% & \ goto 100 ! If not, treat sort of like a 'RUN' 30010 req$=mid(req$,dummy+1%,len(req$)) ! Strip out the CCL name & \ cclmode%=1% ! Say we are operating in CCL mode & \ goto 100 ! and away we go... 30200 ! Set output redirection as per OPT%(3%) & & if opt%(3%)=1% then od%=kb% ! Default output to terminal & \ return 30210 open "TAPE.MAP" for output as file dk% ! Open disk file & \ od%=dk% ! Print or disk & \ redir%=1% ! Say redirection is active & \ return & 30300 ! Clear output redirection as per OPT%(3%) & & kill wfile$ ! Delete temp file, ERL=30300 30302 if opt%(3%)=1% then return ! If was a default output 30310 close #dk% ! Close the file & \ if opt%(3%)=2% then return ! If was a disk mode, bail out 30320 dummy$=sys(chr$(6%)+chr$(-28%)+chr$(0%)+chr$(0%)+chr$(0%)+chr$(0%) & +cvt%$(swap%(32056%))+cvt%$(swap%(8000%))+cvt%$(swap%(20856%)) & +lpnam$+chr$(0%)+chr$(0%)+chr$(4%)+chr$(0%)) ! Spool and delete & \ redir%=0% ! Say redirection is inactive & \ return & 30400 ! Initialize EBCDIC to ASCII translation string & & upa%=ascii(upa$) ! ASCII code of UPA$ & \ ebc.asc$="" & +upa$+chr$(1%)+chr$(2%)+chr$(3%)+upa$+chr$(9%)+upa$+chr$(127%) & +upa$+upa$+upa$+chr$(11%)+chr$(12%)+chr$(13%)+chr$(14%)+chr$(15%) 30410 ebc.asc$=ebc.asc$+chr$(16%)+chr$(17%)+chr$(18%)+upa$+upa$+upa$+chr$(8%) & +upa$+chr$(24%)+upa$+upa$+upa$+chr$(28%)+chr$(29%)+chr$(30%)+chr$(31%) & +string$(5%,upa%)+chr$(10%)+chr$(23%)+chr$(27%) 30420 ebc.asc$=ebc.asc$+string$(5%,upa%)+chr$(5%)+chr$(6%)+chr$(7%) & +upa$+upa$+chr$(22%)+string$(4%,upa%)+chr$(4%) & +string$(4%,upa%)+chr$(20%)+chr$(21%)+upa$+upa$ 30430 ebc.asc$=ebc.asc$+" "+string$(10%,upa%) & +"."+"<"+"("+"+"+"|" 30440 ebc.asc$=ebc.asc$+"&"+string$(9%,upa%) & +"!$"+"*);^" & +"-/"+string$(9%,upa%) & +","+"%_>?" & +string$(8%,upa%) 30450 ebc.asc$=ebc.asc$+upa$+"`:#"+"@'="+chr$(34%) & +upa$+"abc"+"defg" & +"hi"+string$(7%,upa%) & +"jkl"+"mnop" & +"qr"+string$(6%,upa%) 30460 ebc.asc$=ebc.asc$+upa$+"~st"+"uvwx" & +"yz"+upa$+upa$+upa$+"["+upa$+upa$ ! [? & +string$(13%,upa%) & +"]"+upa$+upa$ ! ]? & +"{ABC"+"DEFG" 30470 ebc.asc$=ebc.asc$+"HI"+string$(6%,upa%) & +"}JKL"+"MNOP" & +"QR"+string$(6%,upa%) & +"\"+upa$+"ST"+"UVWX" & +"YZ"+string$(6%,upa%) 30480 ebc.asc$=ebc.asc$+"0123"+"4567" & +"89"+string$(6%,upa%) & \ return & 30500 ! Initialize ASCII to EBCDIC translation string & & upe%=ascii(upe$) ! ASCII code of UPE$ & \ asc.ebc$="" & +upe$+chr$(1%)+chr$(2%)+chr$(3%)+upe$+chr$(45%)+chr$(46%)+chr$(47%) & +chr$(22%)+chr$(5%)+chr$(37%)+chr$(11%)+chr$(12%)+chr$(13%)+chr$(14%) & +chr$(15%) 30510 asc.ebc$=asc.ebc$+chr$(16%)+chr$(17%)+chr$(18%)+upe$+chr$(60%) & +chr$(61%)+chr$(50%)+chr$(28%)+chr$(24%)+chr$(25%)+chr$(63%)+chr$(39%) & +chr$(28%)+chr$(29%)+chr$(30%)+chr$(31%)+chr$(64%)+chr$(90%) & +chr$(127%)+chr$(123%)+chr$(91%)+chr$(108%)+chr$(80%)+chr$(125%) 30520 asc.ebc$=asc.ebc$+chr$(77%)+chr$(93%)+chr$(92%)+chr$(78%)+chr$(107%) & +chr$(96%)+chr$(75%)+chr$(97%)+chr$(240%)+chr$(241%)+chr$(242%) & +chr$(243%)+chr$(244%)+chr$(245%)+chr$(246%)+chr$(247%)+chr$(248%) & +chr$(249%)+chr$(122%)+chr$(94%)+chr$(76%)+chr$(126%)+chr$(110%) & +chr$(111%) 30530 asc.ebc$=asc.ebc$+chr$(124%)+chr$(193%)+chr$(194%)+chr$(195%) & +chr$(196%)+chr$(197%)+chr$(198%)+chr$(199%)+chr$(200%)+chr$(201%) & +chr$(209%)+chr$(210%)+chr$(211%)+chr$(212%)+chr$(213%)+chr$(214%) & +chr$(215%)+chr$(216%)+chr$(217%)+chr$(226%)+chr$(227%)+chr$(228%) & +chr$(229%)+chr$(230%) 30540 asc.ebc$=asc.ebc$+chr$(231%)+chr$(232%)+chr$(233%)+chr$(173%) & +chr$(224%)+chr$(189%)+chr$(95%)+chr$(109%)+chr$(121%)+chr$(129%) & +chr$(130%)+chr$(131%)+chr$(132%)+chr$(133%)+chr$(134%)+chr$(135%) & +chr$(136%)+chr$(137%)+chr$(145%)+chr$(146%)+chr$(147%)+chr$(148%) & +chr$(149%)+chr$(150%) 30550 asc.ebc$=asc.ebc$+chr$(151%)+chr$(152%)+chr$(153%)+chr$(162%) & +chr$(163%)+chr$(164%)+chr$(165%)+chr$(166%)+chr$(167%)+chr$(168%) & +chr$(169%)+chr$(139%)+chr$(79%)+chr$(155%)+chr$(161%)+chr$(7%) & +string$(128%,upe%) & \ return & 32300 ! Initialize error handling and print signon message & & on error goto 32400 ! Set up error handling & \ def* fnt$ & \ t=time(0%) & \ t1=int(t/3600%) & \ t2=int((t-t1*3600%)/60%) & \ t3=int(t-t1*3600%-t2*60%) & \ fnt$=right(num1$(t1+100%),2%)+":"+ & right(num1$(t2+100%),2%)+":"+ & right(num1$(t3+100%),2%) & \ fnend ! Function to display time as HH:MM:SS & \ def* fnu%(dummy$) & \ fnu%=(uflag% or (instr(1%,dummy$,upa$))) & \ fnend ! Function to detect unprintables & \ def* fne$(erno%) & \ fne$=cvt$$(right(sys(chr$(6%)+chr$(9%)+chr$(erno%)),3%),5%) & \ fnend ! Function to return error msg & \ def* fnc & \ dummy$=sys(chr$(6%)+upa$+chr$(0%)+chr$(0%)) & \ fnc=swap%(cvt$%(mid(dummy$,7%,2%))) & +(65536.0*ascii(mid(dummy$,16%,1%))) & \ fnend ! Function to return CPU time & \ hex1$=hex1$+string$(16%,i%) for i%=48% to 57% & \ hex1$=hex1$+string$(16%,i%) for i%=65% to 70% & \ hex2$=hex2$+'0123456789ABCDEF' for i%=1% to 16% & \ legal$=string$(32%,0%)+" "+string$(15%,0%)+"0123456789" & +string$(7%,0%)+"ABCDEFGHIJKLMNOPQRSTUVWXYZ"+string$(6%,0%) & +"ABCDEFGHIJKLMNOPQRSTUVWXYZ" & \ def* fnh$(dummy$) & \ fnh$=xlate(dummy$,hex1$)+xlate(dummy$,hex2$) & \ fnend ! Function to convert to hex & \ def* fnm%(arg1%,arg2%) & \ if arg1%0% then goto 32304 ! If in CCL mode, no header, please & else print #kb%,"VMTAPE V1.0-00A "; ! print program ID, system name & \ print #kb%,fne$(0%) & \ print #kb% 32304 dummy=ascii(left(sys(chr$(6%)+upa$+chr$(0%)+chr$(0%)),1%))/2% & \ if dummy<10% then wfile$="TAPE0"+num1$(dummy)+".CMS" & else wfile$="TAPE"+num1$(dummy)+".CMS" ! Make TAPEXX.CMS filename 32305 return 32310 ! Initialize/reset ^C trap & & dummy$=sys(chr$(6%)+chr$(-7%)) ! Set ^C trap & \ return 32320 ! Reset ^C trap, go to 300 & & gosub 32310 ! Reset ^C trap & \ goto 300 ! And re-prompt user 32400 ! Error handlers & ! & erno%=err ! Error number & \ resume 32320 if erno%=28% ! Control-C detected & \ resume 200 if erl=200% ! Input errors loop & \ resume 20020 if erl=20110% ! Bad numeric argument & \ resume 22000 if erl=13010% ! Write-protected tape & \ resume 23000 if erl=110% ! Tape not available & \ resume 26000 if erl=20310% ! Another bad numeric argument & \ resume 24000 if erno%=13% ! ?Data error on device & \ resume 23000 if erno%=39% ! ?Magtape select error & \ resume 32767 if (erl=210% and erno%=11%) ! EOF on console input & \ resume 28510 if (erl=28500% and erno%=11%) ! EOF on tape input & \ resume 2170 if (erl=2130% and erno%=11%) ! ^Z during QUERY & \ resume 2150 if (erno%=5% and erl=2140%) ! Not found for KILL & \ resume 30302 if (erno%=5% and erl=30300%) ! Not found for KILL & \ resume 24000 if erl=28500% ! ?Device hung (during GET) & \ resume 29010 if (erl=29000% and erno%=4%) ! No room for write & \ resume 1040 if (erl=1020% and erno%=5%) ! No more files & \ resume 1030 if (erl=1010% and erno%=2%) ! Illegal filename & \ resume 1030 if (erl=1020% and erno%=2%) ! Another illegal & \ resume 1200 if erl=1120% ! Eof on input file for DUMP 32410 print #kb%,fne$(erno%);" at line";erl ! One we don't do, print & stop 32766 print "Panic!" !** debug 32767 end ! Not as simple as it looked, eh?