Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/toscip.fai
There are no other files named toscip.fai in the archive.
;<UTILITIES>TOSCIP.FAI.36, 30-Dec-81 00:40:50, Edit by ADMIN.MRC
; Fix not swapping TABFLG
;<UTILITIES>TOSCIP.FAI.35, 23-Dec-81 22:46:03, Edit by ADMIN.MRC
;<UTILITIES>TOSCIP.FAI.34, 3-Dec-81 14:41:53, Edit by ADMIN.MRC
;<UTILITIES>TOSCIP.FAI.33, 3-Dec-81 14:34:58, Edit by ADMIN.MRC
;<UTILITIES>TOSCIP.FAI.32, 3-Dec-81 14:28:38, Edit by ADMIN.MRC
; Fix not swapping CM%NOP references (the test was a no-op!)
;<UTILITIES>TOSCIP.FAI.31, 3-Dec-81 14:20:50, Edit by ADMIN.MRC
;<UTILITIES>TOSCIP.FAI.30, 3-Dec-81 14:14:57, Edit by ADMIN.MRC
; Insert missing confirm, do not demand having MTA0:
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.29, 12-Nov-79 10:07:12, Edit by J.JQJOHNSON
;clean up CHKFMT
;ACCT:<JQJ>TOSCIP.FAI.5, 4-Oct-78 09:50:40, Edit by J.JQJOHNSON
; cleaned up error handling again
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.17, 3-Oct-78 17:09:45, Edit by J.JQJOHNSON
; reworked logic for reading and writing file lists
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.15, 27-Sep-78 13:55:09, Edit by J.JQJOHNSON
; redefine SCIP PRINT, and add SCIP TEXT
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.13, 26-Sep-78 15:41:35, Edit by J.JQJOHNSON
; added recovery routines for sites not having cm%fix
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.12, 26-Sep-78 12:50:29, Edit by J.JQJOHNSON
; fixed bug in indirect file error recovery
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.10, 15-Sep-78 16:05:26, Edit by J.JQJOHNSON
; added much more winning help facility
;ACCT:<SOURCES.CUSP>TOSCIP.FAI.9, 14-Sep-78 20:40:13, Edit by J.JQJOHNSON
; fix error in READ that left an extra blank on all lines, forbid SKIP past
; eot, add indirect files, reorganize comnd parsing tables.
;acct:<sources.cusp>toscip.fai.5, 21-Jun-78 20:15:34, Tvedit by B.BENIGHT
; added the 'SCIP' commands for simplified transport between Scip and LOTS.
;PS:<J.JQJOHNSON>TOSCIP.FAI.14, 20-Mar-78 08:53:57, Edit by J.JQJOHNSON
; fix error in READ FBA logic
;acct:<sources.cusp>toscip.fai.3, 10-Mar-78 Edit by J.JQJohnson
; miscellaneous cleanup, added FBA output, and start of a help facility
title TOSCIP Read and write SCIP-format tapes
; original author: Steve Uhlir, August 1977.
subttl symbols
search monsym
asuppress
;registers
p=17 ;Stack pointer
char=16 ;Current character returned by .GTCHR
chropg=15 ;The number of characters left on the current
;page of the input file.
srcptr=14 ;Pointer in to current page.
lstptr=13 ;Pointer to the output string
srccol=12 ;Column in the current line (for expanding tabs)
reccnt=11 ;Count of the number of records written so far.
;Used to expand to an integral number of blocks.
chrcnt=10 ;The number of charcters which have been output
;in the current record. This is similar to SRCCOL
;however tabs and end of line may cause them to
;to get out of phase. Also CHRCNT counts down to
;zero while SRCCOL counts up to whatever.
filpt=7 ;ptr into array of jfns
temp=6 ;Temporary storage register
temp2=5 ;Temporary storage.
flag=0 ;Register for various flags (see below)
;character names
cspace=40 ;ASCII for a space
clfeed=12 ;ASCII for a line feed
cffeed=14 ;ASCII for a form feed
ctab=11 ;ASCII for a tab
ccrtn=15 ;ASCII for carriage return
;flags (in AC 0)
eolflg==1 ;Flag which is set on reaching the end of a line
eofflg==2 ;Flag which is set on end of file
raiflg==4 ;Flag which is set if lower case is to be
;converted to upper case.
ebcflg==10 ;Flag which is set if translation to/from EBCDIC
;is desired.
spcflg==20 ;Flag used in deleting trailing spaces.
chrflg==40 ;Flag which is set if a non null is read from
;the tape in the current line.
nlfflg==100 ;Null file read flag for detecting end of tape.
cccflg==200 ;Translate to or from CC chars.
tabflg==<1,,0> ;Flag which is set if we are in the midst of
;expanding a tab in to spaces.
;record formats. N.B. used in dispatch tables in READ, WRITE, and DISPLAY
.fb==0
.fba==1
.vb==2 ;not yet implemented
.vba==3 ;not yet implemented
.d==4 ;not yet implemented
.da==5 ;not yet implemented
.wyl==6 ;not yet implemented
;characteristics of various formats
f%ebc==1b0 ;must be ebcdic
f%asc==1b1 ;must be ascii
f%ccc==1b2 ;must have cc chars
f%fix==1b3 ;fixed format
f%vfm==1b4 ;V format
f%dfm==1b5 ;D format
; the following table should correspond to RFMTAB. This one is used for
; format displays, and should be sorted by format number
rcfmtb: f%fix+[asciz/FB/]
f%ccc!f%fix+[asciz/FBA/]
f%vfm!f%ebc+[asciz/VB/]
f%vfm!f%ccc!f%ebc+[asciz/VBA/]
f%dfm!f%ebc+[asciz/D/]
f%dfm!f%ccc!f%asc+[asciz/DA/]
f%ebc+[asciz/Wylbur/]
lrcftb==.-rcfmtb
;parameters for building data areas
pdlen==30 ;pdl
lcmdln==500 ;command line (for COMND)
latomb==100 ;atom buffer (for COMND)
mappag==100 ;where to map in files for WRITE
minblk== 4 ;Smallest allowed blocksize.
maxblk== ^d32000 ;Largest allowed blocksize. 32000.
minrec== 1 ;Smallest allowed record length.
maxrec== 400 ;largest allowed record length. 256.
;note that changing the above 4 values will not effect
;the messages in the LRECL and BLKSIZE commands.
;defaults
defden== .sjd16 ;default density = 1600 bpi
deflre== ^d80 ;default lrecl
defblk== ^d8000 ;default blksize
defomt== deflre ;default omit column
defrec== .fb ;currently, 0=FB
OPDEF CALL [PUSHJ P,0]
OPDEF RET [POPJ P,0]
DEFINE RETSKP <
JRST RSKP>
subttl some useful macros
; parse a noise word
define noise (foo) <
movei 2,[<.cmnoi>*1b8
point 7,[asciz\foo\]
]
call docom
>
; parse a number, with help
define number (deflt,foo) <
movei 2,[<.cmnum>*1b8+cm%sdh+cm%hpp+cm%dpp
=10
point 7,[asciz\foo\]
point 7,[asciz\deflt\]
]
call docom
>
;macro to generate new symbols
ifdef for,<
define gensy1 (foo,bar) <
define foo ' <..%'bar>
>>;fail
ifndef for,<
define gensy1 (foo,bar) <
define foo <..%'bar>
>>;macro
define gensym (foo) <
ifndef ..%00,<..%00==0>
..%00==..%00+1
gensy1(foo,\..%00)
>
;build a chain of function descriptor blocks
;to define a linked list of function descriptors, simply include
;them in order in your file, followed by a FDBEND to signal the
;end of this list:
; foo: fdb(disp1,.cmkey,,keytab) ;parse a keyword
; fdb(disp2,.cmswi,,switab) ;or a switch
; fdb(disp3,.cmcfm) ;or a CR
; fdbend
;then, to use it, say
; initial(csb) ;set up the csb
; repars: parse foo ;do the parse, and dispatch
; ;to either disp1,disp2, or disp3
define fdb (dispatch,typ,flgs,data,hlpm,defm)<
ifndef ..%00,<..%00==0>
..%00==..%00+1
dispatch ;;other halfword is available for flags
..id: gensy1(..id,\..%00)
ifidn <>,<flgs>,<flddb.(typ,,<data>,<hlpm>,<defm>,..id) >
ifdif <>,<flgs>,<flddb.(typ,flgs,<data>,<hlpm>,<defm>,..id) >
>;fdb
;end a chain of function descriptor blocks
define fdbend <..id==0 ;;sorry, but this is necessary too
gensym(..id,\..%00)
>;fdbend
;parse a chain of fdb macros, dispatching appropriately.
define parse (foo) <
movei 2,foo+1 ;;note the +1 !!!
call docom
jrst @-1(3)
>;parse
define table<
0 ;filled by next tend
..t==. ;used by next tend
>;table
define tend <
..u==.
reloc ..t-1
<..u-..t>,,<..u-..t>
reloc ..u
>;tend
;help text
define help (x) < skip [asciz \x
\]
>;help
subttl impure data
curpag: 0
srclin: block 1
srcpag: block 1
filjfn: block 1
tapjfn: block 1 ;JFN for the tape drive
indjfn: block 1 ;JFN for indirect file, if any
lfilst== 30
fillst: block lfilst ;file stack
lrecl: deflre ;LRECL setting. Initially set to 80.
omit: defomt ;omit column
blksiz: defblk ;BLKSIZE .....
den: defden ;DEN ... Initially 1600bpi (DEN=3)
recfm: defrec ;RECFM.
laschr: block 1 ;Pointer to first space of last sting of spaces
ccchar: block 1 ;carriage control character for next line.
mtinfb: 6 ;MT information buffer (gets info from the
block 6 ;.MOINF MTOPR function.)
cmdlin: block lcmdln ;Storage for the COMND JSYS command line
atombf: block latomb ;COMND JSYS storage
filblk: 0 ;GTJFN block. Used with COMND JSYS
.priin,,.priou ;No defaults are used. The flags are set
block 15 ;in the first word of this block as required
;for the access desired.
recmul: block 1 ;Number of records per block.
;Maximum record length in words (4 char./word)
recbuf: block <maxrec+4>/4 ;Storage for current record
recend==.
outbuf: block <maxrec+5>/5 ;output block. Note it is designed for
;7-bit ascii chars.
pdlst: block pdlen ;Stack
csb: cm%xif+reparse ;COMND Command Status Block
.priin,,.priou
point 7,[asciz/TOSCIP>/]
point 7,cmdlin
point 7,cmdlin
lcmdln*5-1
0
point 7,atombf
latomb*5-1
filblk
tapnam: block 2
subttl Character translation table
;
; at present no characters are translitterated but the
; facility is available.
;
; Dispatch index values are:
;
; 0 -- all regular characters
; 1 -- characters to be thrown out
; 2 -- lower case letters
; 3 -- tab
; 4 -- form feed
; 5 -- line feed
; 6 -- carriage return
toasc==1b27
define c(ebasc,asceb,index) <
index,,ebasc*toasc+asceb
>
define getebc (ac,char) <
hrrz ac,trntab(char)
>
define getasc (ac,char) <
ldb ac,[point 7,trntab(char),27]
>
; given a character in register number ACSRC
; to get ascii equivalent, use GETASC ac,acsrc
; to get ebcdic equivalent, use GETEBC ac,acsrc
noch1=="?" ;ascii unknown char
noch2==234 ;ebcdic unknown char--lozenge
trntab: ;0 #0
c (0,0,1)
c (1,1,0)
c (2,2,0)
c (3,3,0)
c (noch1,67,0)
c (11,55,0)
c (6,56,0)
c (177,57,0)
c (noch1,26,0)
c (noch1,5,3)
c (noch1,45,5)
c (13,13,0)
c (14,14,4)
c (15,15,6)
c (16,16,0)
c (17,17,0)
;20 #10
c (20,20,0)
c (21,21,0)
c (22,22,0)
c (23,23,0)
c (noch1,74,0)
c (noch1,75,0)
c (10,62,0)
c (noch1,46,0)
c (30,30,0)
c (31,31,0)
c (noch1,77,0)
c (noch1,47,0)
c (34,34,0)
c (35,35,0)
c ("^",36,0) ;should be 36 instead of "^"?
c (37,37,0)
;40 #20
c (noch1,100,0)
c (noch1,132,0)
c (noch1,177,0)
c (noch1,173,0)
c (noch1,133,0)
c (12,154,0)
c (27,120,0)
c (33,175,0)
c (noch1,115,0)
c (noch1,135,0)
c (noch1,134,0)
c (noch1,116,0)
c (noch1,153,0)
c (5,140,0)
c (6,113,0)
c (7,141,0)
;60
c (noch1,360,0)
c (noch1,361,0)
c (26,362,0)
c (noch1,363,0)
c (noch1,364,0)
c (noch1,365,0)
c (noch1,366,0)
c (4,367,0)
c (noch1,370,0)
c (noch1,371,0)
c (noch1,172,0)
c (noch1,136,0)
c (24,114,0)
c (25,176,0)
c (noch1,156,0)
c (32,157,0)
;100 #40
c (" ",174,0)
c (noch1,301,0)
c (noch1,302,0)
c (noch1,303,0)
c (noch1,304,0)
c (noch1,305,0)
c (noch1,306,0)
c (noch1,307,0)
c (noch1,310,0)
c (noch1,311,0)
c (<"^">,321,0)
c (<".">,322,0)
c (74,323,0) ;less than
c (<"(">,324,0)
c (<"+">,325,0)
c (<"|">,326,0)
;120 #50
c (<"&">,327,0)
c (noch1,330,0)
c (noch1,331,0)
c (noch1,342,0)
c (noch1,343,0)
c (noch1,344,0)
c (noch1,345,0)
c (noch1,346,0)
c (noch1,347,0)
c (noch1,350,0)
c (<"!">,351,0)
c (<"$">,255,0)
c (<"*">,340,0)
c (<")">,275,0)
c (<";">,161,0) ;fooey. Maybe this should be =30
c (176,155,0) ;tilde or "not"
;140 #60
c (<"-">,171,0)
c (<"/">,201,2)
c (noch1,202,2)
c (noch1,203,2)
c (noch1,204,2)
c (noch1,205,2)
c (noch1,206,2)
c (noch1,207,2)
c (noch1,210,2)
c (noch1,211,2)
c (<"|">,221,2) ;actually virtical
c (<",">,222,2)
c (<"%">,223,2)
c (<"_">,224,2)
c (76,225,2) ;greater than
c (<"?">,226,2)
;160 #70
c (noch1,227,2)
c (<"^">,230,2)
c (noch1,231,2)
c (noch1,242,2)
c (noch1,243,2)
c (noch1,244,2)
c (noch1,245,2)
c (noch1,246,2)
c (noch1,247,2)
c (<"`">,250,2)
c (<":">,251,2)
c (<"#">,300,0)
c (<"@">,117,0)
c (<"'">,320,0)
c (<"=">,137,0)
c (44,7,0) ;double quote
;200 #80
c (noch1,noch2,0)
c (<"a">,noch2,0)
c (<"b">,noch2,0)
c (<"c">,noch2,0)
c (<"d">,noch2,0)
c (<"e">,noch2,0)
c (<"f">,noch2,0)
c (<"g">,noch2,0)
c (<"h">,noch2,0)
c (<"i">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;220 #90
c (noch1,noch2,0)
c (<"j">,noch2,0)
c (<"k">,noch2,0)
c (<"l">,noch2,0)
c (<"m">,noch2,0)
c (<"n">,noch2,0)
c (<"o">,noch2,0)
c (<"p">,noch2,0)
c (<"q">,noch2,0)
c (<"r">,noch2,0)
c (175,noch2,0) ;open brace
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;240 #a0
c (noch1,noch2,0)
c (noch1,noch2,0)
c (<"s">,noch2,0)
c (<"t">,noch2,0)
c (<"u">,noch2,0)
c (<"v">,noch2,0)
c (<"w">,noch2,0)
c (<"x">,noch2,0)
c (<"y">,noch2,0)
c (<"z">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (<"[">,noch2,0) ;non standard
c (noch1,noch2,0)
c (noch1,noch2,0)
;260 #b0
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (<"]">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;300 #c0
c (173,noch2,0) ;open brace
c (<"A">,noch2,0)
c (<"B">,noch2,0)
c (<"C">,noch2,0)
c (<"D">,noch2,0)
c (<"E">,noch2,0)
c (<"F">,noch2,0)
c (<"G">,noch2,0)
c (<"H">,noch2,0)
c (<"I">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;320 #d0
c (175,noch2,0) ;close brace
c (<"J">,noch2,0)
c (<"K">,noch2,0)
c (<"L">,noch2,0)
c (<"M">,noch2,0)
c (<"N">,noch2,0)
c (<"O">,noch2,0)
c (<"P">,noch2,0)
c (<"Q">,noch2,0)
c (<"R">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;340 #e0
c (<"\">,noch2,0)
c (noch1,noch2,0)
c (<"S">,noch2,0)
c (<"T">,noch2,0)
c (<"U">,noch2,0)
c (<"V">,noch2,0)
c (<"W">,noch2,0)
c (<"X">,noch2,0)
c (<"Y">,noch2,0)
c (<"Z">,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;360 #f0
c (<"0">,noch2,0)
c (<"1">,noch2,0)
c (<"2">,noch2,0)
c (<"3">,noch2,0)
c (<"4">,noch2,0)
c (<"5">,noch2,0)
c (<"6">,noch2,0)
c (<"7">,noch2,0)
c (<"8">,noch2,0)
c (<"9">,noch2,0)
c (<"|">,noch2,0) ;long vertical
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
c (noch1,noch2,0)
;400 #100
subttl ildbf -- Reading a character from a file
; ILDBF reads a single character from a file using PMAP
;
; Calling sequence: PUSHJ P,ILDBF
; <end of file return>
; <line number return>
; <character return>
;
; Information Required:
;
; CHROPG Register containing the number of characters
; which have not been read on the currently
; mapped page.
; SRCPTR Register which points to the last character read
; CURPAG Contains next file page to be mapped.
; filjfn Contains JFN of the file being read.
; MAPPAG Process page to map to.
;
; Information Returned:
;
; CHAR Register which recieves the character read
;
; If the end of file is reached no character is returned.
; If a line number is encountered, and the calling
; program so desires, the digits of the line number will
; be returned as normal characters.
;
; AC1 and AC2 may be modified.
ildbf: sojl chropg,newpag ;Get a new page if this is empty
ildb char,srcptr ;Get a character
movei 1,1 ;Test the low order bit of word
tdnn 1,(srcptr) ;containing character for lin#s
aos (p) ;Normal return
rskp: aos (p) ;Line number being read return
r: ret ;End of file return
newpag:
hrr 1,curpag ;Get next page number
hrl 1,filjfn ;And file pointer
rpacs
erjmp nonxpg
tlnn 2,(pa%pex) ;see if page exists
jrst nonxpg ;nope...end of file
move 2,[400000,,mappag] ;Destination
hrlzi 3,(pm%rd)
pmap
aos curpag ;Update page number
movei chropg,5000 ;and characters on page
move srcptr,[point 7,mappag*1000] ;Init byte pointer
jrst ildbf
nonxpg: ;End of file read
hrroi 1,-1 ;Unmap page
move 2,[400000,,mappag]
setz 3,
pmap
ret ;(Real EOF return location)
subttl .gtchr -- Reading and Translating a file character
; .gtchr uses ILDBF to read characters from a file. It
; discards all control characters except TAB, LINE FEED,
; and FORM FEED. ABs are expanded in to the correct
; number of blanks.
;
; Calling sequence: PUSHJ P,.gtchr
; <delimiter return>
; <non delimeter return>
;
; Information Required:
;
; EOLFLG Flag bit in AC0 indicating end of line
; EOFFLG Flag bit in AC0 indicating end of file
; RAIFLG Flag bit in AC0 indicating whether or not
; lower case should be coverted to upper case.
; (Conversion occurs if bit is set.)
; LSTPTR Register pointing to sting to be used for
; listing this line.
; SRCCOL Register containing the current column in
; the source. This is mainly used for
; expanding tabs.
;
; Information Returned:
;
; CHAR Register containing character read.
; SRCLIN Current line number, if a line number was read.
; SRCPAG Incremented for each form feed.
.gtchr: trne flag,eolflg+eofflg ;No characters are read if
;either of these bits are set
jrst rdpeol ;Trying to read past the end of
;the line.
tlze flag,(tabflg)
jrst $tab
call ildbf ;Read a character
jrst geteof ;End of file read
jrst linnum ;Line number read
hlrz 1,trntab(char) ;get dispatch index
jrst @chrtyp(1)
chrtyp: $nonsp ;non-special characters
.gtchr ;throw out
$lowcs ;lower case
$tab
$ffeed ;form feed
$lfeed ;line feed
$crrtn ;carriage return
$lowcs: trne flag,raiflg
trz char,40
$nonsp: aoj srccol,
trne flag,ebcflg
getebc (char,char)
idpb char,lstptr
ret
$ffeed: aos srcpag ;Form feed means we are on the
;next page of the source
movei 1,1
movem 1,srclin
movei char,"1"
trne flag,ebcflg
getebc (char,char)
dpb char,[point 8,recbuf,7]
jrst .gtchr ;But the program does not want
;to see the form feed.
$lfeed: tro flag,eolflg
movei char,cspace
trne flag,ebcflg
getebc (char,char)
idpb char,lstptr
trne flag,cccflg
movem char,ccchar
ret
$crrtn: call ildbf
jrst $lfeed
jrst $lfeed
cain char,clfeed
jrst $lfeed
hrroi 1,-1
adjbp 1,srcptr
move srcptr,1
aoj chropg,
trnn flag,cccflg
jrst $lfeed
tro flag,eolflg
movei char,"+"
trne flag,ebcflg
getebc (char,char)
movem char,ccchar
movei char,cspace
trne flag,ebcflg
getebc (char,char)
idpb char,lstptr
ret
$tab: movei char,cspace
aoj srccol,
trne flag,ebcflg
getebc (char,char)
idpb char,lstptr
trne srccol,7 ;If the current column is a
tlo flag,(tabflg)
ret ;multiple of 8 then return
geteof: tro flag,eofflg
rdpeol: movei char,cspace ;Reading past the end of the lin
trne flag,ebcflg
getebc (char,char)
idpb char,lstptr
ret ;returns a line feed.
linnum: move 1,(srcptr)
camn 1,[byte (7) cspace,cspace,cspace,cspace,cspace(1)1]
jrst apmrk
hrroi 1,-1
adjbp 1,srcptr
movei 3,12
nin ;Get line number
jfcl ;probably a binary file
movem 2,srclin
movei 1,5
adjbp 1,srcptr ;and skip past it
move srcptr,1
subi chropg,5
jrst .gtchr
apmrk: subi chropg,4
movei 1,4
adjbp 1,srcptr
move srcptr,1
call ildbf
jfcl
jfcl
move 1,(srcptr)
came 1,[byte (7) ccrtn,ccrtn,cffeed,0,0]
jfcl ;probably a binary file
subi chropg,4
movei 1,4
adjbp 1,srcptr
move srcptr,1
jrst $ffeed
subttl main program
start: reset ;Starting address
move p,[iowd pdlen,pdlst] ;Initialize stack
;top of main loop. Return here after successfully processing command,
;or on various errors
parcmd: movei 2,[<.cmini>*1b8] ;Initialize parse
call docom ;parse the field
repars: move p,[iowd pdlen,pdlst] ;reinitialize stack
hrroi 1,-1 ;Reparse address. Release any
rljfn ; stray JFNs that are around.
jfcl ;don't care if there is an error
parse (keycl)
keycl: fdb(dokey,.cmkey,,comtab) ;Command word
fdb(doind,.cmtok,cm%sdh,<-1,,[asciz/@/]>,<
@FILE.TYP for indirect file>)
fdb(dokey,.cmkey,cm%sdh,lngcmd) ;Second block of commands
fdbend
comtab: table ;List of commands
[asciz/ASCII/],,%ascii
[asciz/BLKSIZE/],,%blksz
[asciz/DENSITY/],,%den
[asciz/DISPLAY/],,%disp
[asciz/EBCDIC/],,%ebcdi
[asciz/EOT/],,%eot
[asciz/HELP/],,%help
[asciz/LRECL/],,%lrecl
[asciz/NO/],,%no...
[asciz/OMIT/],,%omit
[asciz/PAUSE/],,%pause
[asciz/QUIT/],,%quit
[asciz/RAISE/],,%raise
[asciz/READ/],,%read
[asciz/RECFM/],,%recfm
[asciz/REWIND/],,%rewnd
[asciz/SCIP/],,%scf
[asciz/SKIP/],,%skip
[asciz/TAPE/],,%tape
[asciz/WRITE/],,%write
tend
;List of addition commands. By splitting these commands in to
;a seperate block one needs to type fewer letters to uniquely
;match a command.
lngcmd: table
[asciz/BLOCK-SIZE/],,%blksz
[asciz/END-OF-TAPE/],,%eot
[asciz/EXIT/],,%quit
[asciz/FORMAT/],,%formt
[asciz/LINE-LENGTH/],,%lrecl
[asciz/LOGICAL-RECORD-LENGTH/],,%lrecl
[asciz/RECORD-FORMAT/],,%recfm
tend
;parsed a keyword
dokey: hrrz 4,(2) ;Get the right half index
jrst (4) ;and go execute the command
;parsed an "@"
help<@FILE.TYP
Read a list of commands from a file.
>;this is not currently displayable
doind: movei 2,[flddb.(.cmifi,cm%sdh,,<indirect filespec>)]
call docom
movem 2,indjfn
call confirm
hrrz 1,indjfn
move 2,[7b5!of%rd]
openf
erjmp[ hrroi 1,[asciz/Can't open indirect file
/]
call conerr
jrst parcmd ]
hrli 1,.priou ;write to tty:
movsm 1,csb+1
jrst parcmd
cmderr: movei 1,.fhslf
geter
hrrz 2,2
caie 2,iox4 ;eof?
caie 2,comnx9 ;eof?
jrst eofok ;yes
hrroi 1,[asciz/Error in COMND parsing:
/]
call conerr
jrst parcmd
eofok: hrroi 1,[asciz/[EOF in command file reached]
/]
psout
move 2,[.priin,,.priou]
movem 2,csb+1 ;update the appropriate csb
setzm indjfn
jrst parcmd
help<NO RAISE
Sets TOSCIP so that lower case is not converted to upper case
on output. Lower case is NEVER converted to upper case on
input as most programs at LOTS handle upper and lower case
as equivalent.
NO ASCII
Equivalent to EBCDIC.
NO EBCDIC
Equivalent to ASCII.
>
%no...: movei 2,nocl
call docom
hrrz 4,(2)
jrst (4)
notab: table
[asciz/ASCII/],,%ebcdic
[asciz/EBCDIC/],,%ascii
[asciz/RAISE/],,%norai
tend
nocl: <.cmkey>*1b8
notab
subttl set parameters
help<BLKSIZE decimal number
Sets the tape blocksize to be used for subsequent reads and
writes. This should be an integral multiple of the desired
Logical RECord Length.
>
%blksz: noise (of tape file is)
number (8000,decimal blocksize) ;Read the blocksize (number)
movem 2,temp
call confirm
cail temp,minblk
caile temp,maxblk
jrst [ hrroi 1,[asciz/Invalid blocksize. Must be between /]
esout
move 2,minblk
call decout
hrroi 1,[asciz/ and /]
psout
move 2,maxblk
call decout
hrroi 1,[asciz/ (decimal)
/]
psout
jrst parcmd ]
movem temp,blksiz ;and save block size
jrst parcmd ;and that's all for now.
help<DENSITY 800 or 1600 or 2 or 3
Sets the density to be used for subsequent reads and writes.
You may use 800 or 1600 bpi, or the IBM equivalents 2 and 3
respectively. It is not advisable to change densities in the
middle of the tape. LOTS will not mind as long as you are
consistent however you will not be able to read your tape on
an IBM system.
>
%den: noise (of tape is)
movei 2,dencl ;read the density
call docom
hrrz 4,(2) ;get the internal density code.
movem 4,temp
call confirm
movem temp,den ;and save density
jrst parcmd ;and done.
dentab: table ;List of allowed densities
[asciz/1600/],,.sjd16
[asciz/2/],,.sjdn8
[asciz/3/],,.sjd16
[asciz/800/],,.sjdn8
tend
dencl: <.cmkey>*1b8+cm%hpp+cm%sdh ;Parse the density.
dentab
point 7,[asciz/1600 or 800 bpi is presently available.
These correspond to DEN=3 and 2 respectively on the JCL
/]
help<LRECL number
Sets the logical record length to be used in subsequent reads
and writes. this may be any value between 1 and 256. If you
need to write a larger size record see a member of the LOTS
staff as there is a minor modification which can be made to the
program which will allow this.
>
%lrecl: noise (of tape file is)
number (80,decimal record length)
movem 2,temp
call confirm
cail temp,minrec
caile temp,maxrec
jrst [ hrroi 1,[asciz/Invalid record length. Must be between /]
esout
move 2,minrec
call decout
hrroi 1,[asciz/ and /]
psout
move 2,maxrec
call decout
hrroi 1,[asciz/ (decimal)
/]
psout
jrst parcmd ]
movem temp,lrecl ;and save lrecl
movem temp,omit
jrst parcmd
help<RECFM fb or fba
select the record-format "format". On reading from tape, choose the
format in which the file was written. On writing, choose (normally)
one of the following:
FB "fixed block", for card images, etc.
FBA FB, but tape file contains carriage control characters
in col. 1 of each record.
If you specify FBA, then the first character of each logical
record on the tape will be presumed to contain Fortran-style
carriage control characters. Carriage returns, CRLFs, and
form feeds will be converted to or from carriage control
characters as appropriate.
>
%recfm: noise (of tape file is) ;set record format
movei 2,rfmcl
call docom
hrrz 4,(2)
movem 4,temp
call confirm
movem temp,recfm
jrst parcmd
rfmtab: table ;List of allowed formats
[asciz/FB/],,.fb
[asciz/FBA/],,.fba
tend
rfmcl: <.cmkey>*1b8 ;Parse record format
rfmtab
help<RAISE
Sets TOSCIP to convert lower case to upper case on output. Upper
case is NOT converted to lower case on input. It is important to
use this command if you are transferring program text to an IBM
system, since no IBM compiler will accept lower case input. If
you are transferring text, such as a term paper, then you would
probably want to use NO RAISE instead, to insure that the
conversion did NOT take place.
>
%raise: noise (lowercase letters)
call confirm ;result in lower case being
tro flag,raiflg ;converted to upper case.
jrst parcmd
%norai: noise (lowercase letters) ;clear the upper case flag
call confirm
trz flag,raiflg
jrst parcmd
help<EBCDIC
Sets TOSCIP to translate to EBCDIC on output and from EBCDIC
on input. Files which contain control characters, other than
tabs, carriage returns, and line feeds may get changed in the
process as not all characters have an equivalent.
>
%ebcdi: noise (translation in effect)
call confirm ;Set flag to indicate that
tro flag,ebcflg ; translation to EBCDIC is desired
jrst parcmd
help<ASCII
Sets TOSCIP to read and write without translation until an
EBCDIC command is seen. This assumes that the files will contain
ASCII text.
>
%ascii: noise (character set) ;Clear EBCDIC flag
call confirm
trz flag,ebcflg
jrst parcmd
help<OMIT column-number
On READing from tape, throw away any characters on a record at
or after this column. The default is "omit 73" which omits the
sequence number columns on card images.
>
%omit: noise (columns starting at)
number (81,decimal column number)
movem 2,temp
call confirm
soj temp,
cail temp,1
camle temp,lrecl
jrst [ hrroi 1,[asciz/Invalid omit column. Must be between 2 and LRECL:
/]
esout
jrst parcmd ]
movem temp,omit
jrst parcmd
help<SCIP print or card
Sets the format to be compatable with the public execfiles
#fromlots and #tolots at SCIP. The options are:
CARD Best for source programs, data, and SPSS input cards.
Translates lower case into upper case with record length=80.
Not good for files that might have lines longer than 80
characters. This format is more efficient than PRINT if all
the lines will fit in 80 characters.
DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000,DEN=3,OPTCD=Q),
upper-case translation on write, delete columns 73-80 on read.
PRINT Best for text files to be printed at SCIP. Inserts carriage
control characters at the beginning of each line, translating
page marks to "1" in column 1. Does not translate lower case
to upper case; record length=133. Wasteful of space if all
the lines are less than 80 characters long.
DCB=(RECFM=FBA,LRECL=133,BLKSIZE=7980,DEN=3,OPTCD=Q).
TEXT Best for text files to be stored on disk or further edited
using Wylbur. Does not translate lower case to upper case;
record length=133. Wasteful of space if all the lines are less
than 80 characters long.
DCB=(RECFM=FBA,LRECL=133,BLKSIZE=7980,DEN=3,OPTCD=Q).
Any or all of the characteristics of the SCIP formats can be changed
after the SCIP command has been given. The only parameter that it
is advised you change is the RAISE/NO RAISE (e.g. if you wanted
lower case with the CARD format).
>
%SCF: noise (compatible)
movei 2,scfcl
call docom
hrrz temp,(2)
noise (format)
call confirm
jrst (temp)
scftab: table ;defaults for SCIP
[asciz/CARD/],,scfcar
[asciz/PRINT/],,scfpri
[asciz/TEXT/],,scftxt
tend
scfcl: <.cmkey>*1b8
scftab
scftxt: movei temp2,.sjd16
movem temp2,den
trz flag,ebcflg+cccflg
movei temp2,.fb
movem temp2,recfm
movei temp,205 ;i.e. 133.
movem temp,lrecl
movem temp,omit
movei temp,205*74 ;7980. 60. records per block
movem temp,blksize
trz flag,raiflg
jrst parcmd
scfpri: movei temp2,.sjd16
movem temp2,den
trz flag,ebcflg+cccflg
movei temp2,.fba
movem temp2,recfm
movei temp,205
movem temp,lrecl
movem temp,omit
movei temp,205*74
movem temp,blksize
trz flag,raiflg
jrst parcmd
scfcar: movei temp2,.sjd16
movem temp2,den
trz flag,ebcflg+cccflg
movei temp,120
movem temp,lrecl
movem temp,omit
movei temp,.fb
movem temp,recfm
movei temp,120*144 ;8000. i.e. 100 records per block
movem temp,blksize
tro flag,raiflg
jrst parcmd
;TAPE command
%tape: noise (drive specification is)
movei 2,tapecl
call docom
hlrz 1,2 ;get device type
caie 1,.dvdes+.dvmta ;device must be mta:
jrst [ hrroi 1,[asciz/Device must be magnetic tape.
/]
esout
jrst parcmd ]
push p,2 ;save designator over confirm
call confirm
pop p,2
call setdev ;set things up
jrst parcmd
tapecl: flddb.(.cmdev,,,<Tape device name>,<MTA0:>)
subttl termination commands
help<QUIT
Exit from TOSCIP. This unloads the tape and deassigns the tape
drive.
>
%quit: call confirm
skipe tapnam
call opnmtr ;Unload tape and deassign it.
jrst qanywy ;Could not open MTA: quit anyway
hrrz 1,tapjfn
movei 2,.morul
mtopr
qanywy: hrroi 1,-1 ;Release all devices
reld
jfcl
MOVE 1,TAPJFN ;IS FILE OPENED ?
GTSTS ; IF SO, CLOSE IT
jumpge 2,fin
MOVE 1,TAPJFN
CLOSF
ercal [hrroi 1,[asciz/Cannot close tape:
/]
jrst conerr ]
fin: haltf
jrst start
help<PAUSE
Temporarily exits from the program. The tape drive will still
be assigned to you. You may use any EXEC commands you wish.
If you run another program (without PUSHing) you will have to
get TOSCIP again but this is not fatal. To continue type
CONTINUE, or START, or TOSCIP to the "@" prompt.
>
%pause: call confirm ;Exit without any cleanup
hrroi 1,[asciz/Remember you still have the tape drive assigned.
Type CONTINUE to resume execution.
/]
psout ;Warn the user he still has MTA:
haltf
jrst parcmd
subttl write file to tape
wrtcl: <.cmfil>*1b8+cm%sdh+cm%hpp
0
point 7,[asciz/File to be written to tape/]
help<WRITE input filespec {,optionally addtional files}
Writes a file, or group of files to the tape using the current
format settings. As each file is written the user is notified
of the progress of the transfer. Each filespec may contain
wildcards, and may hence imply writing of several files.
>
%write: noise (disk file)
movsi filpt,-lfilst
write0: movei 2,wrtcl ;get the file name
movsi 3,(gj%old+gj%ifg+gj%flg+gj%xtn)
movem 3,filblk ;Set flag bits in GTJFN block
call docom
movem 2,fillst(filpt)
morcmd: parse (multf)
multf: fdb(morfil,.cmcma,cm%sdh)
fdb(wrtfil,.cmcfm)
fdbend
morfil: aobjn filpt,write0
hrroi 1,[asciz/Too many file names specified.
/]
esout
jrst parcmd
wrtfil: hrlzi filpt,1(filpt) ;rebuild aobjn pointer
movn filpt,filpt ;filpt:= - #_of_filespecs,,0
wrtf0: move 1,fillst(filpt)
movem 1,filjfn
wrtf1: call nxtfil ;go write a file
move 1,filjfn
gnjfn
jrst unstkf ;assume that an error from GNJFN means
;there is no next JFN.
jrst wrtf1 ;ah. Go do another in this group
unstkf: aobjn filpt,wrtf0 ;more groups?
jrst parcmd ;no. All done
;write the next file on the list
nxtfil: skipl temp,recfm
caile temp,wrtfml
jrst wrtbad
call @wrtfm(temp) ;use apropriate routine for this recfm
ret ;all done
wrtfm: wrtfb
wrtfba
wrtfml==.-wrtfm
wrtbad: hrroi 1,[asciz/Unimplemented record format for write.
/]
esout
ret
wrtfba: movei char,cspace
trne flag,ebcflg
getebc (char,char)
movem char,ccchar
jrst nxtf1
wrtfb:
; jrst nxtf1
nxtf1: movei 1,.priou
hrrz 2,filjfn
setz 3,
jfns ;tell user which file we are on.
hrrz 1,filjfn
move 2,[7b5+of%rd] ;Open file for 7 bit read
openf
erjmp[ hrroi 1,[asciz/Can not open source file:
/]
esout
jrst parcmd ]
call opnmtw ;open for write
jrst parcmd ;oops
call inirdt ;Initialize tape
jrst parcmd ;oops
setz reccnt, ;zero number of records output in this file.
setz chropg, ;Zero the number of characters left to
;force the reading of the first page.
setzm curpag ;Start by reading page zero
setzm srclin ;Zero the (printer) line number of current line
movei 1,1
movem 1,srcpag ;Set (printer) page to one.
trz flag,eofflg+eolflg ;Not at end of line or file
;Loop here for each record
reclop: move chrcnt,lrecl ;Number of characters desired.
move lstptr,[point 8,recbuf] ;Pointer to string that will be output
trz flag,eolflg ;Clear end of line each time through
setz srccol, ;Start at begining of line
aos srclin ;increment line #
move temp,ccchar ;get carriage control character
trne flag,cccflg
idpb temp,lstptr ;and store if desired
call .gtchr ;Get a character (and put it in RECBUF)
sojge chrcnt,.-1 ;And loop until the desired number of
;characters have been read. (reading
;beyond the end of line returns a space)
trne flag,eolflg ;If the end of line flag is not set then
jrst shrtln ; the line is too long. Line is ok.
trne flag,eofflg ;May be the end of file
jrst aldone ;if so clean up for this file.
setz lstptr,
call .gtchr ;This really is an overly long line.
trnn flag,eolflg+eofflg
jrst .-2 ;Loop until we have read the entire line
hrroi 1,[asciz/Line /]
esout ;And warn the user.
move 2,srclin ;Tell him what line number
call decout
hrroi 1,[asciz/ on page /]
psout
move 2,srcpag ;And page number
call decout
hrroi 1,[asciz/ too long. Line truncated./]
psout
shrtln: hrrz 1,tapjfn
move 2,[point 8,recbuf]
movn 3,lrecl
sout ;write a record to the tape. Because the
;blocksize is set properly the system
;handles blocking, up to the last one.
aoja reccnt,reclop ;Increment the number of records
;And loop for the next record
aldone: setzm recbuf ;Zero the buffer to pad with
move 1,[recbuf,,recbuf+1] ;nulls if necessary
blt 1,recend-1
move 5,reccnt
idiv 5,recmul
caie 6,0 ;If an integral number of
addi 5,1 ;blocks have been written
imul 5,recmul ;then
sub 5,reccnt
sojl 5,nopad ;no padding is needed
;###Change to an unconditional
;branch to stop padding
hrrz 1,tapjfn
padnul: move 2,[point 8,recbuf] ;else loop outputting nulls
movn 3,lrecl
sout
addi reccnt,1
sojge 5,padnul
nopad: hrrz 1,tapjfn ;Clean up an go away
closf
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
hrrz 1,filjfn
tlo 1,(co%nrj) ;May be multiple files
closf
ercal [hrroi 1,[asciz/Can't close disk file:
/]
jrst conerr ]
hrroi 1,[asciz/ [OK]
/]
psout
ret ;all done, finally, with this file
subttl read a file from tape
readcl: <.cmfil>*1b8+cm%sdh+cm%hpp
0
point 7,[asciz/File to be read from tape/]
help<READ output file name
Reads one or more files from the tape, using the current format
settings, in to the designated file. If the BLOCKSIZE is not
an integral multiple of the record length it is rounded toward
the record length. That is if it is less than the record length
it is rounded up, otherwise it is rounded down. The tape is
left after the file which is read. If several file names are
specified (separated by commas), then that many files will be
read from the tape.
>
%read: noise (from tape to disk file)
movsi filpt,-lfilst
read0: movei 2,readcl ;get file name
movsi 3,(gj%fou+gj%xtn)
movem 3,filblk ;Get output JFN
call docom
movem 2,fillst(filpt)
parse reamul
reamul: fdb(reacma,.cmcma)
fdb(reacfm,.cmcfm)
fdbend
reacma: aobjn filpt,read0
hrroi 1,[asciz/Too many file names specified.
/]
esout
jrst parcmd
reacfm: hrlzi filpt,1(filpt) ;rebuild aobjn ptr for rescan
movn filpt,filpt ;filpt:= - #_of_filespecs,,0
read1: hrrz 1,fillst(filpt)
movem 1,filjfn
movei 1,.priou ;print name of file
hrrz 2,filjfn
setz 3,
jfns
hrrz 1,filjfn
move 2,[7b5+of%wr] ;Open output file
openf
erjmp [hrroi 1,[asciz/Cannot open output file:
/]
call conerr
jrst parcmd ]
call opnmtr ;Open tape for reading
jrst parcmd ;Could not open tape
call inirdt ;Initialize tape format, density, parity,
jrst parcmd ;and record size.
tro flag,nlfflg ;Assume null file -- which means end of tape
skipl 1,recfm ;which record format is this?
caile 1,.reafl ;less than max.?
jrst [call inpbad
jrst .+2 ]
call @.reafm(1) ;go do all the work
hrrz 1,filjfn ;close up
closf
ercal [hrroi 1,[asciz/Can't close file:
/]
jrst conerr ]
aobjn filpt,read1 ;back for more
jrst parcmd
.reafm: inpfb ;FB
inpfba ;FBA
.reafl==.-.reafm
inpbad: hrroi 1,[asciz/Unimplemented record format for READ:
/]
esout
ret
;FBA format (may have bugs in it?)
inpfba: call inpfb1 ;do all but the last carriage return
hrrz 1,filjfn ;put in the last CR
hrroi 2,[asciz/
/]
setz 3,
sout
ercal [hrroi 1,[asciz/SOUT: /]
jrst conerr ]
ret
inpfb1: hrrz 1,tapjfn ;read a line (logical record)
move 2,[point 8,recbuf]
movn 3,lrecl
sin
erjmp mabeof ;an error may be the end of file
move 1,[point 8,recbuf] ;Get ready to throw out nulls
move 2,[point 7,outbuf] ;and chop off trailing blanks.
move 3,omit ;length of line
sojl 3,inpfb1 ;padding line of all nulls?
ildb char,1
jumpe char,.-2 ;skip nulls at beginning of line
trzn flag,nlfflg ;We've read at least one line.
call reacc ;do carriage control (not on first)
trz flag,spcflg+chrflg ;nothing seen yet in this line
call skpnul ;translate and dump the line
jrst inpfb1 ;null record
setz 3,
idpb 3,2 ;zero the character after last
hrrz 1,filjfn
hrroi 2,outbuf
sout ;(Output an ASCIZ string)
ercal [hrroi 1,[asciz/SOUT: /]
jrst conerr ]
jrst inpfb1 ; and do another...
inpfb: hrrz 1,tapjfn ;read a line (logical record)
move 2,[point 8,recbuf]
movn 3,lrecl
sin
erjmp mabeof ;an error may be the end of file
trz flag,nlfflg ;We've read at least one line.
move 1,[point 8,recbuf] ;Get ready to throw out nulls
move 2,[point 7,outbuf] ;and chop off trailing blanks.
move 3,omit
trz flag,spcflg+chrflg ;nothing seen yet in this line
call skpnul ;translate and move the line
jrst inpfb ;null record
movei 3,ccrtn ; add a CRLF on the end
idpb 3,2
movei 3,clfeed
idpb 3,2
setz 3,
idpb 3,2 ;zero the character after last
hrrz 1,filjfn ;dump the line
hrroi 2,outbuf
sout ;(Output an ASCIZ string)
ercal [hrroi 1,[asciz/SOUT: /]
jrst conerr ]
jrst inpfb
;move a 8-bit line in recbuf to 7-bit bytes in outbuf,
;eliminating nulls and stripping trailing blanks as we go.
;enter: 1/ pointer to start of input
; 2/ pointer to place to start putting output in output buffer
; 3/ number of characters to read from input line
;return: +1, null record
; +2 , normally with updated pointers in 1 and 2
skpnul: movem 2,laschr ;a blank record turns into crlf
skpnl1: sojl 3,outlin ;go through the line again
ildb char,1
jumpe char,skpnl1 ;throw out nulls
tro flag,chrflg ;a character has been read.
trne flag,ebcflg ;translate if desired
getasc (char,char)
idpb char,2 ;output character
caie char,cspace
movem 2,laschr ;last non-blank seen
jrst skpnl1 ;and loop
outlin: trzn flag,chrflg ;If no characters then this
ret ;was a record for padding so throw it out.
move 2,laschr ;then truncate at begining of group of spaces
retskp
;translate carriage control characters, and place in outbuf
;enter: 2/ pointer to outbuf
; char/ the carriage control character
;return: appropriate string in outbuf, and 2 updated
reacc: tro flag,chrflg
trne flag,ebcflg ;translating from EBCDIC?
getasc (char,char) ; yes.
movsi temp,-reatbl
reacc1: hlrz temp2,reatb(temp) ;get a typical cc char
caie char,temp2 ;match?
aobjn temp,reacc1 ; no
move temp2,reatb(temp) ;here's the string to use
hrli temp2,(<point 7,0>)
reacc2: ildb char,temp2
jumpe char,r
idpb char,2
jrst reacc2
;table of CC characters, and their string equivalents
reatb: " ",,[byte (7) ccrtn,clfeed,0]
"1",,[byte (7) cffeed,ccrtn,0]
"+",,[byte (7) ccrtn,0]
"-",,[byte (7) ccrtn,clfeed,clfeed,0]
"0",,[byte (7) ccrtn,clfeed,clfeed,clfeed,0]
reatbl==.-reatb
[byte (7) ccrtn,clfeed,0] ;the default is CRLF
mabeof: gtsts
tlnn 2,(gs%eof)
call [ hrroi 1,[asciz/SIN: /]
jrst conerr ] ;If this isn't an end of file
;then I don't know what it is.
hrrz 1,tapjfn
closf
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
trnn flag,nlfflg ;If not a null file then
ret ;go on as usual
hrroi 1,[asciz/Attempt to read beyond end of tape!
/]
esout ;Warn user of end of tape.
seto temp, ;back up one file
jrst backup ;callret
subttl tape movement commands
help<EOT
Advance to the end of tape. This command is useful if you wish
to add files to the end of an existing tape.
>
%eot: call confirm ;Skip to end of tape
call opnmtr ;open tape for read
jrst parcmd ;open failed
hrrz 1,tapjfn
movei 2,.moeot
mtopr
ercal [hrroi 1,[asciz/Can't advance to EOT:
/]
jrst conerr ]
closf
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
jrst parcmd
help<REWIND
Rewinds the tape to load point (beginning).
>
%rewnd: call confirm ;rewind tape
call opnmtr ;Open MTA: (for read)
jrst parcmd ;Error on opening file
movei 2,.morew
mtopr
erjmp [hrroi 1,[asciz/Cannot rewind the tape:
/]
call conerr
jrst parcmd ]
closf
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
jrst parcmd
help<SKIP decimal integer
Skips the specified number of files forward. A negative
number skips backwards. SKIP 0 is a nop.
>
%skip: noise (mta files) ;Skip <n> files
number (decimal number of files to skip)
movem 2,temp
call confirm
jumpe temp,parcmd ;skip 0 is a noop
jumpl temp,bakfls ;skip backwards
;skip forward
fwdfls: call opnmtr ;Open tape for reading
jrst parcmd ;Open failed
call inirdt ;init tape parameters
jrst parcmd ;couldn't do it
move 1,tapjfn
bin ;read a byte
jumpe 2,skpset ;may be end of tape
notske: movei 2,.mofwf ;skip forward
mtopr
ercal [hrroi 1,[asciz/Can't skip forward:
/]
jrst conerr ]
closf ;Got there so clean up
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
sojg temp,fwdfls
jrst parcmd
skpset: gtsts
tlnn 2,(gs%eof) ;End of file on the first byte means a
; null file which means EOT
jrst notske
closf ;End of tape clean up
ercal [hrroi 1,[asciz/EOT, but can't close tape:
/]
jrst conerr ]
hrroi 1,[asciz/Attempt to skip past end of tape!
/]
esout
seto temp, ;back up one file
call backup
jrst parcmd
;skip backwards
bakfls: call backup
jrst parcmd
backup: call opnmtr
ret
move 1,tapjfn
movei 2,.mobkf
baklop: mtopr
ercal [hrroi 1,[asciz/Can't backspace tape:
/]
jrst conerr ]
aojl temp,baklop
movei 2,.monop
mtopr
ercal [hrroi 1,[asciz/Problem on tape:
/]
jrst conerr ]
movei 2,.moinf
movei 3,mtinfb
mtopr
erjmp [hrroi 1,[asciz/Can't get tape status:
/]
call conerr
jrst bakdon ]
movei 2,.mobkf
mtopr
erjmp [hrroi 1,[asciz/Can't backspace tape:
/]
call conerr
jrst bakdon ]
skipn mtinfb+.moirc
jrst bakdon
movei 2,.mofwf
mtopr ;and skip over last tape mark
ercal [hrroi 1,[asciz/Can't skip forward:
/]
jrst conerr ]
bakdon: closf ;clean up
ercal [hrroi 1,[asciz/Can't close tape:
/]
jrst conerr ]
ret
subttl information commands
help<FORMAT
Synonymous with DISPLAY.
>
%FORMT: jrst displ0
help<DISPLAY
Display the DCB from the IBM JCL which corresponds to the current
settings of various parameters. This is (almost) the DCB which
should be used to read a tape written here, and it should be the
same as the DCB which was used to write a tape which is being read
here. Note that the blocksize must be an integral multiple of
the logical record length. However, the DISPLAY command does not
check this. When you actually read or write a file the
blocksize will be forced to an integral number of records so
a DISPLAY command which is given after a WRITE will indicate the
format that was actually used.
>
%disp: noise (currently selected format)
displ0: call confirm
hrroi 1,[asciz/The present setting is for an unlabeled tape with
DCB=(LABEL=(?,NL),LRECL=/]
psout
move 2,lrecl
call decout
hrroi 1,[asciz/,BLKSIZE=/]
psout
move 2,blksiz
call decout
hrroi 1,[asciz/,RECFM=/]
psout
skipl 1,recfm
caile 1,lrcftb ;in range?
jrst [ hrroi 1,[asciz/unknown/]
jrst .+2 ]
hrro 1,rcfmtb(1)
psout
hrroi 1,[asciz/,DEN=/]
psout
move 2,den
subi 2,1
call decout
trne flag,ebcflg
jrst notasc
hrroi 1,[asciz/,OPTCD=Q/]
psout
notasc: hrroi 1,[asciz/)
/]
psout
hrroi 1,[asciz/Note that lower case is not converted to upper case.
/]
trne flag,raiflg
hrroi 1,[asciz/Note that lower case is converted to upper case.
/]
psout
jrst parcmd
;HELP command
help<HELP command-name
Types information on various commands.
>
%help: parse hlpfdb
hlpfdb: fdb(hlpkey,.cmkey,,comtab) ;same keywords as command level
fdb(hlpcfm,.cmcfm) ;or CR for general info.
fdb(hlpall,.cmtok,,<-1,,[asciz/*/]>) ;or * for all
fdbend
hlpmsg: asciz\
This program may be used to read and write tapes in IBM-compatible format.
There are commands for setting up tape parameters, displaying the currently
selected parameters, moving to a specific file on the tape, reading, and
writing. Some of the more important commands include:
DISPLAY show the currently selected parameters. When reading a tape,
be sure that these match the parameters that were specified when
the tape was written. When writing, be sure to record these
parameters for future reference.
READ filename read the next tape file into the disk file named "filename".
WRITE filename write the disk file named "filename" to tape. You can
specify several filenames separated by commas.
SCIP default select a prepackaged default format compatible with utilities
at SCIP. Currently, you may choose:
CARD --- suitable for card-image data sets and greatest portability.
PRINT --- suitable for text files to be printed on an IBM printer.
TEXT --- suitable for text files to be edited at SCIP.
For a list of commands, type "?". For information a particular command,
give the command HELP followed by the name of the command.
\
;parse HELP <cr>
hlpcfm: hrroi 1,hlpmsg
psout
jrst parcmd
;parse HELP <command name>
hlpkey: hrrz temp,(2) ;get righthalf index from command table
call confirm
hlrz 1,-1(temp) ;get the instruction preceding the command
caie 1,(<skip>) ;if it's SKIP [ASCIZ/.../] we win
jrst hlpx
hrro 1,-1(temp) ;get the text for the command
psout
jrst parcmd ;back for more
hlpx: hrroi 1,[asciz/
Sorry. No help is available on that topic.
/]
psout
jrst parcmd ;back for more
;parse HELP *
hlpall: call confirm
movn temp,comtab ;get count
adjsp temp,1
hrri temp,comtab+1 ;get addr of first command
hlpal0: hrrz 2,(temp) ;get righthalf index
hlrz 1,-1(2) ;get the instruction preceding the command
caie 1,(<skip>) ;if it's SKIP [ASCIZ/.../] we win
jrst hlpal1 ;no help on this
hrro 1,-1(2) ;get help message
psout ;print it
hlpal1: aobjn temp,hlpal0 ;and back for more
jrst parcmd
subttl utility routines
;parse a confirmation CR
confir: movei 2,[<.cmcfm>*1b8]
call docom
skipn indjfn ;in an indirect file?
ret ;no. successful confirmation
hrroi 1,cmdlin ;yes. print the command line
psout
ret
;parse an arbitrary field
docom: movei 1,csb
comnd
ercal cmderr
tlnn 1,(cm%nop) ;could we parse it?
ret ;yes
hrroi 1,[asciz//]
esout ;will never get to here at LOTS!
movei 1,.priou
hrloi 2,.fhslf ;error is already in 2
setz 3,
erstr
jfcl
call [ hrroi 1,[asciz/Error within an error:
/]
jrst conerr ]
jrst parcmd ;and exit from within loop
opnmtw: movsi 1,(gj%fou+gj%sht) ;open MTA: for output
skipn tapnam
jrst [ hrroi 1,[asciz/No magnetic tape specified. Use TAPE command.
/]
esout
ret ]
hrroi 2,tapnam
gtjfn
erjmp mtgtfa
movem 1,tapjfn
move 2,[8b5+of%wr]
openf
erjmp mtopfa
retskp
opnmtr: movsi 1,(gj%old+gj%sht) ;open MTA: for input
skipn tapnam
jrst [ hrroi 1,[asciz/No magnetic tape specified. Use TAPE command.
/]
esout
ret ]
hrroi 2,tapnam
gtjfn
erjmp mtgtfa
movem 1,tapjfn
move 2,[8b5+of%rd]
openf
erjmp mtopfa
retskp
mtgtfa: hrroi 1,[asciz/Can't get JFN on MTA:
/]
setzm tapnam
jrst conerr
mtopfa: hrroi 1,[asciz/Can't open MTA:
/]
call conerr ;Open failure
setzm tapnam
move 1,tapjfn ;Clean up
rljfn
jfcl
ret
;initialize tape
inirdt: call chkfmt ;check for consistent format
hrrz 1,tapjfn ;Set tape parameters
movei 2,.mocle ;Clear MTOPR errors.
mtopr
ercal [hrroi 1,[asciz/Can't clear tape error status:
/]
jrst conerr ]
movei 2,.mosdm ;Set data mode to industry compatible
movei 3,.sjdm8
mtopr
erjmp [hrroi 1,[asciz/Can't set tape data mode:
/]
jrst conerr ]
movei 2,.mospr ;Set odd parity
movei 3,.sjpro
mtopr
erjmp [hrroi 1,[asciz/Can't set tape parity:
/]
jrst conerr ]
movei 2,.mosrs ;set record size to BLKSIZE
move 3,blksiz
mtopr
erjmp [hrroi 1,[asciz/Can't set BLKSIZE:
/]
jrst conerr ]
movei 2,.mosdn ;Set density to desired density
move 3,den
mtopr
erjmp [hrroi 1,[asciz/Can't set tape density:
/]
jrst conerr ]
retskp
;check consistency of record format
chkfmt: move 1,recfm
skipl temp,rcfmtb(1) ;get flags
caile 1,lrcftb
jrst [hrroi 1,[asciz/Invalid record format specified.
/]
esout
ret ]
trz flag,cccflg ;check for cc chars.
tlne temp,(f%ccc)
tro flag,cccflg ;yes
tlne temp,(f%ebc)
troe flag,ebcflg
jrst chkfm1
hrroi temp,[asciz/Warning: record format requires EBCDIC.
/]
esout
jrst chkfm2
chkfm1: tlne temp,(f%asc)
trzn flag,ebcflg
jrst chkfm2
hrroi 1,[asciz/Warning: record format requires ASCII.
/]
esout
chkfm2: tlnn temp,(f%fix) ;fixed format?
jrst chkfm3
move 3,blksiz ;check that blocksize is a multiple of
;the record length.
idiv 3,lrecl
movem 3,recmul ;Same number of records per block
jumpe 4,chkfm3 ;remainder=0 implies blocksize ok
skipn 3,
addi 3,1 ;Up a zero to one so we round the
movem 3,recmul ; blocksize toward the record length.
imul 3,lrecl ;recalculate the blocksize.
movem 3,blksiz
hrroi 1,[asciz/
Warning: Blocksize not a multiple of record length. /]
esout ;Warn user.
move 2,blksiz
call decout
hrroi 1,[asciz/ used instead.
/]
psout
chkfm3: ;should check for proper BLKSIZE for
;f%dfm and f%vfm
ret
setdev: hrroi 1,tapnam
devst
jrst [ hrroi 1,[asciz/Tape drive not available:
/]
jrst conerr ]
movei 3,":"
idpb 3,1 ;end with ":" for gtjfn
move 1,2
asnd ;Assign MTA:
jrst [ hrroi 1,[asciz/Can not assign tape drive:
/]
setzm tapnam
jrst conerr ]
ret
;print a free-format decimal number
;call 2/ number to be printed
decout: movei 1,.priou
movei 3,12
nout
erjmp [hrroi 1,[asciz/NOUT: /]
jrst conerr ]
ret
;continuable error
conerr: esout
push p,2
push p,3
movei 1,.priou
hrloi 2,.fhslf
setz 3,
erstr
jfcl
jrst [ hrroi 1,[asciz/OOPS! Error within an error.
/]
esout
jrst .+1 ]
pop p,3
pop p,2
ret
; Local modes:
; Mode: FAIL
; End:
end start