home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
cdccyber.zip
/
cdcazl.asm
< prev
next >
Wrap
Assembly Source File
|
1988-08-16
|
66KB
|
1,894 lines
*comdeck cdkcbtz convert blanks to zeroes in a word.
btz ctext cdkcbtz - convert blanks to zeroes in a word.
btz space 4,10
if -def,qual$,1
qual cdkcbtz
base d
btz space 4,10
*** btz - convert blanks to zeroes in a word.
*
* g. m. townsend. 83/08/22. code based on *comcztb*.
*
* btz converts all blanks in a word to 00 characters.
btz space 4,10
*** btz converts all blanks in a word to 00 characters.
*
* entry (x1) = word to be converted.
* (b1) = 1.
*
* exit (x6) = converted word.
* (x7) = final character mask.
*
* uses x - 3, 6, 7.
* b - none.
* a - 3.
*
* calls none.
btz> subr entry/exit
sa3 btza
bx7 x1-x3 convert blanks to 00, others to misc
sa3 a3+b1
bx6 x3*x7 remove upper bit from all characters
bx7 -x3*x7 isolate upper bits
ix6 x6+x3 any non-zero character produces carry
bx6 x6+x7 merge upper bits and carries
bx7 -x3*x6 all non-zero characters = 40b
bx6 x7
lx7 -5
ix7 x6-x7
bx7 x6+x7 now have mask
bx6 x7*x1 clear spaces from original word
eq btz> and return
btza con 10h
con 37373737373737373737b
btz space 4,10
base *
qual$ if -def,qual$
qual *
btz> equ /cdkcbtz/btz>
qual$ endif
btz endx
*comdeck cdkcmfs move fortran string.
mfs ctext cdkcmfs - move fortran string.
mfs space 4,10
if -def,qual$,1
qual cdkcmfs
base d
mfs space 4,10
*** mfs - move fortran string.
*
* g. m. townsend. 83/05/31.
*
* mfs moves a (possibly unaligned) ftn5 character string
* into a word-aligned buffer.
mfs space 4,10
*** mfs moves a ftn5 character string into a buffer. this is
* particularly useful for subroutines which need their data
* word-aligned. if the string is too long for the buffer, it
* is truncated; if too short, it is padded with zeroes.
*
* mfs also works for ftn4 or ftn5 hollerith strings (characters
* stored in variables of other types); since such strings
* have no associated length they will be copied until the
* buffer is filled.
*
* strings must be in cm (not ecs/lcm) and must not exceed
* 777777b characters in length.
*
* entry (x1) = aplist entry specifying string in cm
* (see ftn5 reference manual) or address
* of hollerith string.
* (b1) = 1.
* (b6) = fwa of output buffer.
* (b7) = size of output buffer, in words.
*
* exit (b6) = lwa+1 of buffer.
*
* uses x - 1, 2, 6, 7.
* b - 3, 4, 5, 6, 7.
* a - 2, 6.
*
* calls none.
mfs> subr entry/exit
sa2 x1 (a2/x2) = current input word
mx7 -6 (x7) = one-character mask
ax1 24
bx6 -x1+x7 -(beginning char position)
ax1 6
sb3 x1 (b3) = number of chars left (0 = unknown).
sb4 x6+10 (b4) = number of chars left in x2
ix1 x6+x6 -2 * bcp
ix1 x6+x1 -3 * bcp
lx1 1 -6 * bcp (0 to -54)
sb5 x1
ax2 b5 position x2 to first input character
mx6 0 (x6) = output word in progress
sb5 54 (b5) = shift count for stuffing output
nz b3,mfs2 if input char count provided
sb3 -1 no, use huge count
eq mfs2 join main loop
mfs1 sa2 a2+1 get next input word
sb4 10 indicate 10 chars available
mfs2 zr b3,mfs4 if input string exhausted
zr b4,mfs1 if need to load new input word
mfs3 lx2 6 no, position to next character
sb3 b3-b1 count character from string
bx1 -x7*x2 isolate it
sb4 b4-b1 count character from x2
lx1 b5 position it
sb5 b5-6 adjust shift count for next time
bx6 x6+x1 add into output word
pl b5,mfs2 if output word not full
sa6 b6 yes, save output word
sb7 b7-b1 count it
sb6 b6+b1 bump store address
sb5 54 reset shift count
mx6 0 clear output word
gt b7,mfs2 if output buffer not full
eq mfs> if full, return
mfs4 mx2 0 use zeroes for remaining characters
sb4 b0 indicate huge number left
eq mfs3 rejoin loop
mfs space 4,10
base *
qual$ if -def,qual$
qual *
mfs> equ /cdkcmfs/mfs>
qual$ endif
mfs endx
*comdeck cdkcmvc move characters.
mvc ctext cdkcmvc - cm string move.
mvc space 4,10
if -def,qual$,1
qual cdkcmvc
base d
mvc space 4,10
*** mvc - move character string.
*
* r. o. anderson,
* w. r. sears 75/05/21.
*
* r. o. anderson. 80/07/03. handle char offsets .gt. 9.
*
* mvc moves character strings.
mvc space 4,10
*** mvc moves strings from one location to another on what
* appears to be a character by character basis. mvc does not
* change characters in the destination area that lie beyond the
* space covered by the string that was moved.
*
* entry (a1) = source address.
* (a2) = destination address.
* (b1) = 1.
* (b2) = source character offset (0 to 131071).
* (b3) = destination character offset (0 to 131071).
* (b4) = number of characters to move (0 to 131071).
*
* exit string moved.
*
* uses x - 1, 2, 3, 4, 5, 6, 7.
* b - 2, 3, 4, 5.
* a - 1, 2, 3, 4, 6, 7.
mvc.csiz equ 6 bits per character
mvc.cpw equ 60/mvc.csiz characters per word
mvc4 bx7 x2 set up
sa2 a2-b1 for first
bx6 x2 iteration
sa6 a2 of loop
mvc5 bx5 -x3*x1 -123456789
bx2 x4*x7 abc-------
sa1 a1+b1 klmnopqrst
bx7 x3*x1 k---------
bx7 x5+x7 k123456789
lx7 b2,x7 89k1234567
bx6 -x4*x7 ---1234567
bx6 x6+x2 abc1234567
sb4 b4-mvc.cpw decrement characters left
le b4,mvc6 if done
sa6 a6+b1 store this word
eq mvc5 loop till done
mvc6 sa2 mvca+mvc.cpw-1+b4 get proper edit mask
sb3 b3-60 set up right circular shift of mask
lx2 -b3,x2 ---******-
bx1 x4+x2 *********-
bx3 x4*x2 ----------
bx7 x4*x7 890-------
sa2 a6+b1 abcdefghij
sa4 a2+b1 klmnopqrst
bx2 -x1*x2 ---------j
bx4 -x3*x4 klmnopqrst
bx6 x1*x6 abc123456-
bx7 x3*x7 ---------
bx6 x6+x2 abc123456j
bx7 x7+x4 klmnopqrst
sa6 a2 update
sa7 a4 last words
mvc> subr entry/exit
le b4,mvc> quit if nothing to do
sx6 mvc.csiz x6 = bits per character
mvc0 sb2 b2-10 compute source word address
mi b2,mvc0a if word address ok
sa1 a1+b1 advance 1 word
eq mvc0
mvc0a sb2 b2+10 compute corrected source offset
mx5 1 for mask generation
sb5 b2 save source offset for later
mvc0b sb3 b3-10 compute destination word address
mi b3,mvc0c if word address ok
sa2 a2+b1 advance 1 word
eq mvc0b
mvc0c sb3 b3+10 compute corrected destination offset
sx7 b2 convert
ix7 x7*x6 source offset
sb2 x7 to bits
sx7 b3 convert
ix7 x7*x6 destination offset
sb3 x7 to bits
ax3 x5,b2 build source and
ax4 x5,b3 destination masks
lx5 b1,x3 compensate
bx3 x5*x3 for
lx5 b1,x4 extra
bx4 x5*x4 bit
sx6 a1 get fwa of source area
sb2 b2-b3 b2 is offset difference
pl b2,mvc1 skip if positive
sb2 b2+60 else make it positive
mvc1 sx7 a2 get destination fwa
ix5 x6-x7 see if fwa source .ge. fwa dest.
pl x5,mvc4 if so
sx5 b5+b4 get character offset of lwa source
sx7 mvc.cpw compute
mx6 -1 characters per word
ix6 x6+x7 minus one
ix5 x5+x6 x5 = offset + rounding value
* ix7 x5/x7,b5 word offset of lwa + 1 source
ix7 x5/x7 word offset of lwa + 1 source
sx6 a1 compute lwa + 1
ix5 x6+x7 of source
sx6 a2 see if lwa + 1 source
ix6 x6-x5 .le. fwa destination
pl x6,mvc4 if so
sa1 x5-1 a1 = lwa source
sx6 a2 compute
ix5 x6+x7 lwa + 1 destination
sa2 x5-1 a2 = lwa destination
sx7 mvc.cpw compute
sx6 b4 remainder of
px6 x6,b0 integer divide
px7 x7,b0
nx7 x7,b0
fx5 x6/x7
ux6,b5 x6 restore registers
lx6 x6,b5
ux7,b5 x7
lx7 x7,b5
ux5,b5 x5
lx5 x5,b5
ix5 x5*x7 number of characters / chars per word
ix5 x6-x5 then get
ix5 x5-x7 index into mask table
sb5 mvca+mvc.cpw-1+x5 b5 = pointer to mask
bx6 x3 save
sa6 mvcb both
bx7 x4 masks
sa7 a6+b1 for later
lx6 x1,b2 ^!+"*/[]()
bx5 x4*x6 ^!+-------
bx6 x3*x1 +---------
sa1 a1-b1 0123456789
bx1 -x3*x1 -123456789
bx6 x6+x1 +123456789
lx7 x6,b2 89+1234567
bx6 x4*x7 89+-------
sa1 a1+b1 +"*/[]()^!
lx1 x1,b2 ^!+"*/[]()
bx1 -x4*x1 ---"*/[]()
bx6 x6+x1 89+"*/[]()
sa3 b5 get the edit mask
sb5 b3-60 get mask rotation value
lx3 -b5,x3 **-*******
bx1 x4+x3 **********
bx3 x4*x3 **--------
sa4 a2+b1 %%%%%%%%%%
bx4 -x3*x4 --%%%%%%%%
bx5 x3*x5 ^!--------
bx5 x5+x4 ^!%%%%%%%%
bx2 -x1*x2 ----------
bx4 x1*x6 89+"*/[]()
bx6 x5 ^!%%%%%%%%
sa6 a4 update last word in dest. area
bx6 x4+x2 89+"*/[]()
sa6 a2 update the next to last word
cx1 x1 see
cx3 x3 how many
ix3 x3+x1 characters
sx1 mvc.csiz were
* ix3 x3/x1,b5 used
ix3 x3/x1 used
sb5 x3 and decrement
sb4 b4-b5 the total
le b4,mvc> if done
sa1 a1-b1 0123456789
sa3 mvcb recover
sa4 a3+b1 masks
mvc2 bx5 x3*x1 0---------
bx2 -x4*x7 ---1234567
sa1 a1-b1 abcdefghij
bx7 -x3*x1 -bcdefghij
bx7 x7+x5 0bcdefghij
lx7 b2,x7 ij0bcdefgh
bx6 x4*x7 ij0-------
bx6 x6+x2 ij01234567
sb4 b4-mvc.cpw decrement characters left
le b4,mvc3 if done
sa6 a6-b1 store this word
eq mvc2 loop till done
mvc3 bx6 -x4*x6 ---bcdefgh
sa1 a6-b1 klmnopqrst
bx1 x4*x1 klm-------
bx6 x1+x6 klmbcdefgh
sa6 a1 store last word
eq mvc> return
mvca vfd mvc.csiz/-0,*p/0 mask table
.mvcif ifgt mvc.cpw,2
.mvcset set mvc.csiz
.mvc1up dup mvc.cpw-2
.mvcset set .mvcset+mvc.csiz
vfd .mvcset/-0,*p/0
.mvc1up endd
.mvcif endif
data -0
mvcb bss 2 to save masks
mvc space 4,10
base *
qual$ if -def,qual$
qual *
mvc> equ /cdkcmvc/mvc>
qual$ endif
mvc endx
*comdeck cdkcscs select character set.
scs ctext cdkcscs - select character set.
scs space 4,10
if -def,qual$,1
qual cdkcscs
base d
scs space 4,10
*** scs - select character set.
*
* g. m. townsend. 81/02/17.
*
* scs determines the character set of a file by inspecting the
* first buffer full of data.
scs space 4,10
*** scs looks at a portion of a file to determine whether it is
* display code or 7-in-12 ascii. it does this by seeing if
* there are zero bits where they should be for an ascii file;
* if not, the file is assumed to be in display code. the
* algorithm is not foolproof -- it can falsely diagnose a file
* as ascii if it contains only the display code characters
* a, 5, and 6 (also *:* in 64-character set) in odd-numbered
* columns. despite this, the method works well in practice.
*
* scs looks at all the data in a circular buffer, as indicated
* by the fet. the caller should first issue a read, then call
* scs.
*
* entry (x2) = fet address.
* (b1) = 1.
*
* exit (x6) = 1 if display code.
* (x6) = 0 if buffer is empty.
* (x6) = -1 if nos 812 ascii.
* (x6) = -2 if ut 812 ascii.
*
* uses x - 1, 3, 6.
* b - 2, 3, 4, 5.
* a - 1, 3.
scs> subr entry/exit
recall x2 wait for read to finish
sa1 x2+b1
sb2 x1 (b2) = first
sa1 a1+b1
sb3 x1 (b3) = in
sa1 a1+b1
sb4 x1 (b4) = out
sa1 a1+b1
sb5 x1 (b5) = limit
sx6 b0
eq b3,b4,scs> if empty buffer, return
sa3 scsa (x3) = mask
sx6 b1 assume display code
scs1 sa1 b4 fetch word
bx1 -x3*x1
zr x1,scs2 if ok ascii so far, check more
sa1 b4 check against ut 812 ascii
sa3 scsb
bx1 -x3*x1
nz x1,scs> if display code, return
scs2 sb4 b4+b1 bump pointer
eq b4,b3,scs3 if no more in buffer
lt b4,b5,scs1 if not yet to limit
sb4 b2 go back to first
ne b4,b3,scs1 if more to check
scs3 sx6 -b1 indicate ascii
sa1 scsa
bx1 x1-x3
zr x1,scs> if nos 812 ascii
sx6 -2 indicate ut 812 ascii
eq scs> return
scsa data 41774177417741774177b mask for bits in ascii chars
scsb data 43774377437743774377b mask for ut 812 chars
scs space 4,10
base *
qual$ if -def,qual$
qual *
scs> equ /cdkcscs/scs>
qual$ endif
scs endx
*comdeck cdkcsxt convert characters, sixbit to twelvebit.
sxt ctext cdkcsxt - sixbit to twelve bit character mapping.
sxt space 4,10
if -def,qual$,1
qual cdkcsxt
base d
sxt space 4,10
*** sxt - sixbit to twelve bit character mapping.
*
* r. o. anderson. 75/01/27.
*
* sxt converts a 6-bit character set into a 12-bit character
* set.
sxt space 4,10
*** sxt performs a character mapping operation using a conversion
* table of 1 character per word, right justified, binary zero
* filled. the table is assumed to be long enough to allow
* mapping of any character encountered in the input string.
*
* entry (b1) = 1.
* (b2) = address of input string.
* (b3) = length of input string, in words.
* (b4) = address of output string.
* (b5) = address of conversion table.
*
* exit string converted.
*
* uses x - 1, 2, 6, 7.
* b - none.
* a - 1, 2, 6.
sxt> subr entry/exit
sx6 b3 save input
sa6 sxta string length
sx6 b4 save output
sa6 a6+b1 start address
sb3 b2+b3 compute lwa + 1 of input area
mx7 -6 set up a one byte mask
sxt1 sa1 b2 read up the next word to convert
mx6 0 clear assembly register
.sxt dup 5
lx1 6 get one character
bx2 -x7*x1 in x2
sa2 b5+x2 get replacement
lx6 12 make room for new character
bx6 x6+x2 add in new character
.sxt endd
sa6 b4 store output word
mx6 0 clear assembly register
.sxt dup 5
lx1 6 get one character
bx2 -x7*x1 in x2
sa2 b5+x2 get replacement
lx6 12 make room for new character
bx6 x6+x2 add in new character
.sxt endd
sa6 a6+b1 store output word
sb2 b2+b1 increment in pointer
sb4 a6+b1 increment out pointer
lt b2,b3,sxt1 loop till done
sa1 sxta recover input
sb3 x1 string length
sa1 a1+b1 recover output
sb4 x1 start address
sb2 b2-b3 restore input starting address
eq sxt> return
sxta bss 2 to save length and out start addr
sxt space 4,10
base *
qual$ if -def,qual$
qual *
sxt> equ /cdkcsxt/sxt>
qual$ endif
sxt endx
*comdeck cdkctxs convert characters, twelvebit to sixbit.
txs ctext cdkctxs - twelve bit to sixbit character mapping.
txs space 4,10
if -def,qual$,1
qual cdkctxs
base d
txs space 4,10
*** txs - twelve bit to sixbit character mapping.
*
* r. o. anderson. 75/01/27.
*
* txs converts a 12-bit character set into a 6-bit character
* set.
txs space 4,10
*** txs performs a character mapping operation using a conversion
* table of 1 character per word, right justified, binary zero
* filled. the table is assumed to be long enough to allow
* mapping of any character encountered in the input string.
*
* entry (b1) = 1.
* (b2) = address of input string.
* (b3) = length of input string, in words.
* (b4) = address of output string.
* (b5) = address of conversion table.
*
* exit string converted.
*
* uses x - 1, 2, 6, 7.
* b - none.
* a - 1, 2, 6.
txs> subr entry/exit
sx6 b3 save input
sa6 txsa string length
sx6 b4 save output
sa6 a6+b1 start address
sb3 b2+b3 compute lwa + 1 of input area
mx7 -12 set up a one byte mask
txs1 sa1 b2 read up the next word to convert
mx6 0 clear assembly register
.txs dup 5
lx1 12 get one character
bx2 -x7*x1 in x2
sa2 b5+x2 get replacement
lx6 6 make room for new character
bx6 x6+x2 add in new character
.txs endd
sb2 b2+b1 increment in pointer
ge b2,b3,txs3 store word if input length odd
sa1 b2 else get next word and continue
.txs dup 5
lx1 12 get one character
bx2 -x7*x1 in x2
sa2 b5+x2 get replacement
lx6 6 make room for new character
bx6 x6+x2 add in new character
.txs endd
sa6 b4 store output word
sb2 b2+b1 increment in pointer
sb4 b4+b1 increment out pointer
lt b2,b3,txs1 loop till done
txs2 sa1 txsa recover input
sb3 x1 string length
sa1 a1+b1 recover output
sb4 x1 start address
sb2 b2-b3 restore input starting address
eq txs> return
txs3 lx6 30 position partial word
sa6 b4 save it
eq txs2 to complete exit
txsa bss 2 to save length and out start addr
txs space 4,10
base *
qual$ if -def,qual$
qual *
txs> equ /cdkctxs/txs>
qual$ endif
txs endx
*comdeck cdkcvfn validate file name.
vfn ctext cdkcvfn - validate file name.
vfn space 4,10
if -def,qual$,1
qual cdkcvfn
base d
vfn space 4,10
*** vfn - validate file name.
*
* g. m. townsend. 78/02/02.
*
* vfn checks that a string is a legal file name.
vfn space 4,10
*** entry (x1) = file name, l format.
* (b1) = 1.
*
* exit (x1) = 0 if legal.
*
* uses x - 1, 2, 6.
* b - 2.
* a - none.
vfn> subr entry/exit
mi x1,vfn> if negative, return immediately
bx2 x1
ax2 54
sx2 x2-1r0
pl x2,vfn> if first char numeric, return
sb2 7 (b2) = character counter
mx2 -6 (x2) = character mask
vfn1 lx1 6
bx6 -x2*x1 (x6) = character
zr x6,vfn> if zero character, return
sx6 x6-1r9-1
pl x6,vfn> if illegal character, return
bx1 x2*x1 clear out last char, it is legal
sb2 b2-b1
nz b2,vfn1 if more characters to test
eq vfn> return
vfn space 4,10
base *
qual$ if -def,qual$
qual *
vfn> equ /cdkcvfn/vfn>
qual$ endif
vfn endx
*deck rel
ident cpu.btz
entry btz>
btz title btz - convert blanks to zeroes in a word.
comment convert blanks to zeroes in a word.
*call cdkcbtz
end
ident cpu.mfs
entry mfs>
mfs title mfs - move fortran string.
comment move fortran string.
*call cdkcmfs
end
ident cpu.mvc
entry mvc>
mvc title mvc - move characters.
comment move characters.
*call cdkcmvc
end
ident cpu.scs
entry scs>
scs title scs - select character set.
comment select character set.
*call cdkcscs
end
ident cpu.sxt
entry sxt>
sxt title sxt - convert characters, sixbit to twelvebit.
comment convert characters, sixbit to twelvebit.
*call cdkcsxt
end
ident cpu.txs
entry txs>
txs title txs - convert characters, twelvebit to sixbit.
comment convert characters, twelvebit to sixbit.
*call cdkctxs
end
ident cpu.vfn
entry vfn>
sst
vfn title vfn - validate file name.
comment validate file name.
*call cdkcvfn
end
*deck macrel
ident macrel
entry macrel.,macrel=,macwal=
sst
b1=1
list f
title macrel - system macro interface routines.
comment system macro interface routines.
macrel space 4,10
*** macrel - system macro interface routines.
*
* t. r. ramsey. 76/08/08.
*
* copyright control data corporation. 1976.
macrel space 4,10
*** macrel is a collection of relocatable modules that
* provide the interface between higher level language modules
* and the system macros.
*
* fortran calling sequences are shown in each module along with
* other pertinent information, e.g., entry, exit.
title macrel - system macro interface routines.
macrel space 4,10
** macrel modules translate parameters in higher level
* language calling sequences into macro calling sequences.
* fortran calling sequences mentioned are equivalent to
* cobol (enter using), sympl, etc.
*
* entry fortran *call* and function reference calling
* sequences use the actual parameter list, call by
* reference calling sequence where -
* (a1) = fwa of aplist
* ((a1)) # first parameter
* ((a1+1)) # second parameter
* . .
* . .
* . .
* ((a1+n)) # n-th parameter
* ((a1+n+1)) = 0 (zero) (nominally) (un-needed herein)
* (x1) # first parameter
*
* exit for *call*, typically none, but see individual modules.
* for function references,
* (x6) = function result
* (x7) = second word of two word result, e.g., complex
*
* uses preserves a0
*
* calls macrel. if macro undefined or not coded yet
* macrel= if argument error
*
* needs each module contains a call to a macro whose name is
* the same as the module (except where noted). these
* macros are defined in systext (kronos nos) and cputext
* (scope nos/be) and also in jettext. jettext is the
* preferred system text.
*
* note b1 is set to one upon entry to each module
*
* other macrel is a collection of relocatable modules combined
* into one *update* deck entity named macrel. the
* modules are arranged in the same order as the macros
* in jettext.
macrel. space 4,10
** macrel. - undefined macro processor.
*
* entry (x1) = macro name in 0l format
*
* exit does not exit
*
* uses a6 b1 x6
*
* calls none
*
* needs macros abort, message
macrel. subr entry/exit
sb1 1
bx6 x1
sa6 maca+3
message maca,,rcl
abort
eq macrel.
maca data c* macrel - undefined macro - fill-in.*
macrel= space 4,10
** macrel= - illegal argument processor.
*
* entry (x1) = macro name in 0l format
* (x2) = illegal argument
*
* exit does not exit
*
* uses a6 b1 x0,x1,x2,x6
*
* calls ztb=
*
* needs macros abort, message
macrel= subr entry/exit
sb1 1
bx0 x2 save second argument
lx1 -6
sx2 1r-
bx1 x1+x2
rj =xztb=
bx1 x0
sa6 macb
rj =xztb=
sa6 macb+3
message macb,,rcl
abort ,nd
eq macrel=
macb data c* fill-in - illegal argument >fill-it-in<.*
macwal= space 4,10
** macwal= - word align a 10 or less character parameter.
*
* entry (x1) = ftn/ftn5 argument list item.
*
* exit (x2) = value from argument list, left justified, with
* space fill, unless value was 0b or all spaces, in
* which case, 0b returned.
*
* uses a2,a3,a6 b1,b3,b4,b5,b6,b7 x1,x2,x3,x6,x7
*
* calls mfs>, ztb=.
macwal= subr entry/exit
sb1 1
sb6 macc where mfs can stash the result
sb7 b1 length of mfs buffer
rj =xmfs> move the option
sa2 macc get the result
zr x2,macwal= if nothing specified, return binary zero
bx1 x2 for ztb
rj =xztb= blank out the 00b characters
sa2 macd spaces
bx2 x2-x6
zr x2,macwal= map spaces to zero for ftn5
bx2 x6 for most of our callers, this is best
eq macwal= return
macc bss 1 buffer for mfs
macd data 10h
end
ident excst
entry excst
sst
syscom b1
excst title excst - execute control statement for ftn.
comment (ftn) execute control statement.
excst space 4,10
***** excst - execute control statement for ftn.
*
* r. o. anderson. 83/10/31.
*
* allow ftn program to execute a control statement.
excst space 4,10
*** excst allows an ftn program to execute a control
* statement at termination.
*
* call excst(string)
*
* entry *string* is a hollerith string (ftn4), including
* a line terminator, or a character variable (ftn5).
* in either case, the maximum length is 80 characters.
*
* exit does not return.
*
* calls mfs>, sys=.
excst subr = entry (only)
sb1 1 always
sb6 ccdr where to put the image
sb7 8 maximum buffer length
rj =xmfs> move the string
excst ccdr execute image
* system pcc,r,ccdr execute image (does not return)
endrun in case we did a 1aj command
end
ident close
entry close
sst
b1=1
title close - close file.
comment close file.
close space 4,10
*** close - close file.
*
* call close (file,option)
*
* entry (file) = first word of the fet
* (option) = a hollerith string or character variable
* with any of the following values.
* = 0 or blanks, close with rewind
* = ^nr^, close without rewind
* = ^reel^, close reel with rewind
* = ^reelnr^, close reel without rewind
* = ^reelun^, close reel with rewind, unload
* = ^return^, close with rewind, return
* = ^rewind^, close with rewind
* = ^unload^, close with rewind, unload
*
* exit to argument-error processor if option is unrecognized
* else none
close subr
sb1 1
sa1 a1+b1 point to option
rj =xmacwal= word align option
sa1 a1-b1 reset x1 to be fet address
zr,x2 clo1
sa3 =0hnr
bx4 x2-x3
zr,x4 clo2 if nr
sa3 =0hreel
bx4 x2-x3
zr,x4 clo3 if reel
sa3 =0hreelnr
bx4 x2-x3
zr,x4 clo4 if reelnr
sa3 =0hreelun
bx4 x2-x3
zr,x4 clo5 if reelun
sa3 =0hreturn
bx4 x2-x3
zr,x4 clo6 if return
sa3 =0hrewind
bx4 x2-x3
zr,x4 clo7 if rewind
sa3 =0hunload
bx4 x2-x3
zr,x4 clo8 if unload
sa1 =0lclose
rj =xmacrel= diagnose illegal argument
eq close
clo1 close x1
eq close
clo2 close x1,nr
eq close
clo3 closer x1
eq close
clo4 closer x1,nr
eq close
clo5 closer x1,unload
eq close
clo6 close x1,return
eq close
clo7 close x1
eq close
clo8 close x1,unload
eq close
end
ident open
entry open
sst
b1=1
title open - open file for processing.
comment open file for processing.
open space 4,10
*** open - open file for processing.
*
* call open (file,option)
*
* entry (file) = first word of the fet
* (option) = a hollerith string or character variable
* with any of the following values.
* = 0 or blanks, same as ^alter^
* = ^alter^, open with rewind for i-o
* = ^alternr^, open for i-o
* = ^nr^, open
* = ^read^, open with rewind for input
* = ^readnr^, open for input
* = ^reel^, open reel with rewind
* = ^reelnr^, open reel
* = ^write^, open with rewind for output
* = ^writenr^, open for output
*
* exit to argument-error processor if option is unrecognized
* else none
open subr
sb1 1
sa1 a1+b1 point to option
rj =xmacwal= word align option
sa1 a1-b1 reset x1 to be fet address
zr,x2 ope1
sa3 =0halter
sa4 =0halternr
sa5 =0hnr
bx3 x2-x3
bx4 x2-x4
zr,x3 ope2 if alter
bx5 x2-x5
zr,x4 ope3 if alternr
zr,x5 ope4 if nr
sa3 =0hread
sa4 =0hreadnr
sa5 =0hreel
bx3 x2-x3
bx4 x2-x4
zr,x3 ope5 if read
bx5 x2-x5
zr,x4 ope6 if readnr
zr,x5 ope7 if reel
sa3 =0hreelnr
sa4 =0hwrite
sa5 =0hwritenr
bx3 x2-x3
bx4 x2-x4
zr,x3 ope8 if reelnr
bx5 x2-x5
zr,x4 ope9 if write
zr,x5 ope10 if writenr
sa1 =0lopen
rj =xmacrel= diagnose illegal argument
eq open
ope1 open x1
eq open
ope2 open x1,alter
eq open
ope3 open x1,alternr
eq open
ope4 open x1,nr
eq open
ope5 open x1,read
eq open
ope6 open x1,readnr
eq open
ope7 open x1,reel
eq open
ope8 open x1,reelnr
eq open
ope9 open x1,write
eq open
ope10 open x1,writenr
eq open
end
ident read
entry read
sst
b1=1
title read - read file to cio buffer.
comment read file to cio buffer.
read space 4,10
*** read - read file to cio buffer.
*
* call read (file)
*
* entry (file) = first word of the fet
read subr
sb1 1
read x1
eq read
end
ident writer
entry writer
sst
b1=1
title writer - write end of record.
comment write end of record.
writer space 4,10
*** writer - write end of record.
*
* call writer (file,level)
*
* entry (file) = first word of the fet
* (level) = record level
writer subr
sb1 1
sa3 a1+b1 address of level
sa3 x3 level
writer x1,x3
eq writer
end
ident readc
entry readc
sst
b1=1
title readc - read coded line in *c* format.
comment read coded line in *c* format.
readc space 4,10
*** readc - read coded line in *c* format.
*
* call readc (file,buf,n,status)
*
* transfers data until the end of line byte (0000) is sensed.
*
* entry (file) = first word of the fet
* (buf) = first word of the working buffer
* (n) = word count of the working buffer
*
* exit (status) = 0, transfer complete
* = -1, end-of-file detected on file
* = -2, end-of-information detected on file
* = lwa, end-of-record detected on file before
* transfer was complete
* lwa = address + 1 of last word transferred to
* working buffer
readc subr
sb1 1
sa3 a1+b1 fwa of working buffer
sa4 a3+b1 address of word count
sa5 a4+b1 (x5) = address of status word
bx6 x5
sa4 x4 word count
readc x1,x3,x4
bx6 x1
sa6 x5
eq readc
end
ident readw
entry readw
sst
b1=1
title readw - read data to working buffer.
comment read data to working buffer.
readw space 4,10
*** readw - read data to working buffer.
*
* call readw (file,buf,n,status)
*
* entry (file) = first word of the fet
* (buf) = first word of the working buffer
* (n) = word count of the working buffer
*
* exit (status) = 0, transfer complete
* = -1, end-of-file detected on file
* = -2, end-of-information detected on file
* = lwa, end-of-record detected on file before
* transfer was complete
* lwa = address + 1 of last word transferred to
* working buffer
readw subr
sb1 1
sa3 a1+b1 fwa of working buffer
sa4 a3+b1 address of word count
sa5 a4+b1 (x5) = address of status word
sa4 x4 word count
readw x1,x3,x4
bx6 x1
sa6 x5
eq readw
end
ident writew
entry writew
sst
b1=1
title writew - write data from working buffer.
comment write data from working buffer.
writew space 4,10
*** writew - write data from working buffer.
*
* call writew (file,buf,n)
*
* entry (file) = first word of the fet
* (buf) = first word of the working buffer
* (n) = word count of the working buffer
writew subr
sb1 1
sa3 a1+b1 fwa of working buffer
sa4 a3+b1 address of word count
sa4 x4 word count
writew x1,x3,x4
eq writew
end
ident mtr
entry mtr
sst
b1=1
mtr title mtr - issue monitor calls from ftn.
comment issue monitor calls from ftn.
mtr space 4,10
***** mtr - issue monitor calls from ftn.
*
* b. l. trumbo. 78-aug-31
*
* mtr allows monitor calls to be issued from an ftn program,
* either as a 60-bit request, or in the same format as
* the *system* macro.
mtr space 4,10
*** mtr - issue monitor calls from ftn.
*
* call mtr (ppcall)
* call mtr (ppname,recall)
* call mtr (ppname,recall,arg)
* call mtr (ppname,recall,arg1,arg2)
*
* entry *ppcall* is a 60-bit (integer) quantity, and is
* issued as a monitor call without modification.
* *ppname* is the name of the pp routine to be called,
* left justified. only the upper 18 bits are used.
* *recall* is either zero or non-zero. if it is zero,
* no recall bit is inserted.
* *arg* is an argument to be passed to the pp routine
* called. the lower 36 bits are passed as the lower
* 36 bits of the ra+1 call.
* *arg1* is an argument to be passed to the pp routine
* called. the lower 18 bits are passed as the lower
* 18 bits of the ra+1 call.
* *arg2* is an argument to be passed to the pp routine
* called. the lower 18 bits are passed as bits 18
* thru 35 of the ra+1 call.
*
* exit all input arguments preserved, monitor call issued.
* if recall bit was set in call, ra+1 will be clear.
*
* uses a1,a2,a3,a4, a6
* b1
* x1,x2,x3,x4, x6,x7
*
* calls sys=.
mtr space 4,10
mtr2 bx4 -x6*x4 strip *arg* to 36 bits, assuming no *arg2*
lx3 40d position recall bit
bx2 x2+x4 combine pp name and arg(s)
bx2 x2+x3 or in recall bit
mtr1 bx6 x2
system issue the monitor call in x6
mtr subr = entry/exit
sb1 1 11th commandment
sa2 x1 pick up pp name
sa1 a1+b1 pick up address of *recall* arg
zr x1,mtr1 if only one arg, issue it as is
mx7 18
sa3 x1 pick up *recall* arg
mx4 0 assume zero *arg*
cx3 x3 convert *recall* to a bit
sa1 a1+b1 pick up address of *arg*
cx3 x3
bx2 x7*x2 strip pp name down to 3 chars
cx3 x3
mx6 -36d mask for use at mtr2
cx3 x3 now have only one recall bit
zr x1,mtr2 if no *arg* supplied, use zero
sa4 x1 if *arg* supplied, use it
sa1 a1+b1 pick up address of *arg2*
zr x1,mtr2 if no *arg2*
sa1 x1
mx7 -18d
bx4 -x7*x4 strip *arg1* down to 18 bits
bx1 -x7*x1 strip *arg2* down to 18 bits
lx1 18d
bx4 x4+x1 x4 contains composite arg
eq mtr2
end
ident endrun
entry endrun
sst
b1=1
list f
title endrun - end central program.
comment endrun.
endrun space 4,10
*** endrun - end central program.
*
* call endrun
*
* entry none
*
* exit does not exit
endrun subr
sb1 1
endrun
end
ident recall
entry recall
sst
b1=1
list f
title recall - place program in recall status.
comment place program in recall status.
recall space 4,10
*** recall - place program in recall status.
*
* call recall (status)
*
* entry (status) = 0, one system periodic recall is issued
* = other, program is recalled when bit 0 is set
*
* exit none if (status) =0
* else bit 0 of status is set
recall subr
sb1 1
sa2 x1 status word
zr,x2 rec1 if single recall
recall x1 else, auto-recall
eq recall
rec1 recall
eq recall
end
ident rtime
entry rtime
sst
b1=1
list f
title rtime - obtain real time clock reading.
comment obtain real time clock reading.
rtime space 4,10
*** rtime - obtain real time clock reading.
*
* call rtime (status)
*
* entry none
*
* exit (status) = response
* kronos response -
**t 24/ seconds,36/ milliseconds
*
* scope response -
**t 24/ junk,24/ seconds,12/ qm
*
* time is system software clock time since deadstart
* qm = 1/4096 of a second
rtime subr
sb1 1
bx5 x1
rtime x1
sa1 x5
bx6 x1 return response as function result
eq rtime
end
ident movech
entry movech
sst
syscom b1
movech title movech - mvc> interface for ftn.
comment (ftn) move character strings.
movech space 4,10
***** movech - mvc> interface for ftn.
*
* r. o. anderson. 02/17/76.
*
* ftn interface to the character move subroutine.
movech space 4,10
*** movech - move character strings.
*
* movech source,offsets,destination,offsetd,nchars
*
* moves *nchars* from *source* to *destination*.
*
* entry *source* = the address of the first word of the
* source string.
* *offsets* = the character offset (0 - 131071) into
* *source*.
* *destination* = the address of the first word of
* the destination area.
* *offsetd* = the character offset (0 - 131071) into
* *destination*.
* *nchars* = the number of characters to move.
* (b1) = 1.
*
* exit the string has been moved.
*
* uses x - 1, 2, 3, 4, 5, 6, 7.
* b - 2, 3, 4, 5.
* a - 1, 2, 3, 4, 5, 6, 7.
*
* calls mvc>.
purgmac movech
movech macro source,offsets,dest,offsetd,nchars
r= a1,source
r= b2,offsets
r= a2,dest
r= b3,offsetd
r= b4,nchars
rj =xmvc>
endm
movech space 4,10
*** movech provides an ftn callable interface to the university
* or arizona character string move subroutine.
*
* call movech(src,bcps,dest,bcpd,nchr)
*
* entry *src* is the variable or array containing the first
* character of the source string.
* *bcps* is the beginning character position for the
* string starting in *src* (0 - 131071).
* *dest* is the variable or array containing the first
* character of the destination string.
* *bcpd* is the beginning character position for the
* string starting in *dest* (0 - 131071).
* *nchr* is the number of characters to move.
*
* exit movech will return after moveing *src* to *dest*.
*
* calls mvc>.
movech subr entry/exit
sb1 1 and b1 shall be 1
bx2 x1
mx0 -6 also used below
ax2 24
bx2 -x0*x2
sb2 x2 get character variable offset or zero
sa2 a1+b1
sa1 x1 (a1) = address of source string
sa3 a2+b1
sa2 x2
sb2 b2+x2 (b2) = bcp of source string
sa2 x3 (a2) = address of destination string
ax3 24
bx3 -x0*x3
sb3 x3 get character variable offset or zero
sa3 a3+b1
sa4 x3
sb3 b3+x4 (b3) = bcp of destination string
sa3 a3+b1
sa4 x3
sb4 x4 (b4) = number of characters to move
movech a1,b2,a2,b3,b4 move the strings
eq movech return
end
ident xcon
entry xcon
sst
syscom b1
xcon title xcon - connect/disconnect terminal files.
xcon space 4,10
** xcon - connect a file to a terminal.
*
* call xcon(fet,code)
*
* entry (fet) = fet address
* (code) = <0, disconnect (return) file
* 0, dpc connect
* 1, 128 character ascii connect
* 2, 256 character ascii connect
*
* exit file connected to the terminal
*
xcon subr =
sb1 1
sx2 x1 (x2) = fet address
sa1 a1+b1
sa1 x1
bx3 x1 (x3) = function code
ng x3,xcon2 if only disconnect
status x2 check if local
mx0 11
lx0 1
sa4 x2 get fet+0
bx4 -x0*x4
zr x4,xcon3 if not local
xcon1 open x2,nr,r check device type
sa4 x2 clear all but fn+complete
mx0 43
lx0 1
bx6 x0*x4
sa6 x2
sa4 x2+b1 check for ct device
ax4 48
sx4 x4-2rtt nos
* sx4 x4-2rct-774000b nos/be
zr x4,=xxcon if already ct device, return
xcon2 evict x2,r return local copy
ng x3,=xxcon if only disconnect, return
xcon3 sa1 x2 set filename for assign
mx0 48
bx6 x0*x1
sa6 xconb
sx3 b1 set complete
bx6 x6+x3
sa6 x2
sx4 x2 save fet address
* system pcc,ar,xcona create the ct file
sx2 x4
xcon4 sa1 x2 get fet+0
mx0 43 keep fn+complete
lx0 1
bx1 x0*x1
mx7 1 ascii bit mask
lx7 43
nz x3,xcon5 if not dpc char set
bx6 x1 store fet+0
sa6 x2
sa1 x2+b1 clear ascii bit
bx6 -x7*x1
sa6 a1
eq =xxcon
xcon5 sa4 x2+b1 set ascii bit in fet+1
bx6 x4+x7
sb3 x3
sb3 b3-b1
nz b3,xcon6 if 256 char ascii
sa6 a4
bx6 x1 set fet+0
sa6 x2
eq =xxcon
xcon6 sb3 b3-b1
nz b3,=xxcon if invalid mode
sa6 a4
bx6 x1+x3 set odd bit for 256 char ascii
sa6 x2 set fet+0
eq =xxcon
xcona data h*.assign,ct,*
xconb data 0
end
ident xscs
entry xscs
sst
b1=1
xscs title xscs - scs interface for ftn.
comment (ftn) sense character set.
xscs space 4,10
***** xscs - scs interface for ftn.
*
* s. h. jay 83/02/04.
*
* ftn interface to the sense character set routine.
xscs space 4,10
*** xscs provides an ftn callable link to the university
* of arizona sense character set subroutine.
*
* n = xscs(fet)
*
* entry *fet* is array containing an fet. a read should
* be done on this fet before calling xscs.
*
* exit *n* = 1 for display code,
* 0 if buffer empty,
* -1 if ascii.
*
* calls scs>
xscs subr entry/exit
sb1 1
sx2 x1 (x2) = fet address
rj =xscs>
eq xscs return
end
ident xsxt
entry xsxt
syscom b1
xsxt title xsxt - sxt> interface for ftn.
comment (ftn) convert sixbit to twelvebit.
xsxt space 4,10
***** xsxt - sxt> interface for ftn.
*
* r. o. anderson. 02/17/76.
*
* l. n. shipp. 80/05/09. fix mcs parameter typo.
*
* ftn interface to the sixbit to twelvebit character conversion
* routine.
mcs space 4,10
*** mcs - map character sets into other character sets.
*
* mcs in=,inlen=,inbs=,out=,outbs=,table=
*
* converts the characters in *in* via *table* placing them
* in *out*.
*
* entry *in=* the address of the first word of the input
* character string.
* *inlen=* the length of the input string in words.
* *inbs=* the byte size (6 or 12) of the input chars.
* *out=* the address of the first word of the output
* character string buffer. if *outbs* is .le.
* *inbs*, *out* and *in* may point to the same
* area.
* *outbs=* the byte size (6 or 12) of the output chars.
* *table=* the address of the character set mapping
* table. this table has 1 entry per word,
* right justified with binary zero fill.
* (b1) = 1.
*
* exit the characters have been mapped.
*
* uses x - 1, 2, 6, 7.
* b - 2, 3, 4, 5.
* a - 1, 2, 6.
*
* calls sxs>, sxt>, txs>, or txt>.
purgmac mcs
mcs macroe in,inlen,out,inbs,outbs,table
r= b2,in
r= b3,inlen
r= b4,out
r= b5,table
ifeq inbs,6,2
^%s"mcs1 micro 1,, s
skip 4
ifeq inbs,12d,2
^%s"mcs1 micro 1,, t
skip 1
err input byte size must be 6 or 12.
ifeq outbs,6,2
^%s"mcs2 micro 1,, s
skip 4
ifeq outbs,12d,2
^%s"mcs2 micro 1,, t
skip 1
err output byte size must be 6 or 12.
rj =x'^%s"mcs1'x'^%s"mcs2'>
endm
xsxt space 4,10
*** xsxt provides an ftn callable link to the university of
* arizona sixbit to twelvebit character conversion routine.
*
* call xsxt(in,len,out,tbl)
*
* entry *in* is a variable or array containing the
* characters to be converted (10 per word).
* *len* is the word length of the array *in*.
* *out* is the variable or array to receive the
* converted characters (5 per word).
* *tbl* is an array containing the conversion table.
* this table contains 1 character per word,
* right justified, with binary zero fill.
*
* exit xsxt will return after doing the conversion.
*
* calls sxt>.
xsxt subr entry/exit
sb1 1 and b1 shall be 1
sb2 x1 (b2) = input area address
sa1 a1+b1
sa2 x1
sb3 x2 (b3) = word length of input
sa1 a1+b1
sb4 x1 (b4) = output area address
sa1 a1+b1
sb5 x1 (b5) = conversion table address
mcs in=b2,inlen=b3,out=b4,table=b5,inbs=6,outbs=12
eq xsxt return
end
ident xtxs
entry xtxs
syscom b1
xtxs title xtxs - txs> interface for ftn.
comment (ftn) convert twelvebit to sixbit.
xtxs space 4,10
***** xtxs - txs> interface for ftn.
*
* r. o. anderson. 02/17/76.
*
* l. n. shipp. 80/05/09. fix mcs parameter typo.
*
* ftn interface to the twelvebit to sixbit character conversion
* routine.
mcs space 4,10
*** mcs - map character sets into other character sets.
*
* mcs in=,inlen=,inbs=,out=,outbs=,table=
*
* converts the characters in *in* via *table* placing them
* in *out*.
*
* entry *in=* the address of the first word of the input
* character string.
* *inlen=* the length of the input string in words.
* *inbs=* the byte size (6 or 12) of the input chars.
* *out=* the address of the first word of the output
* character string buffer. if *outbs* is .le.
* *inbs*, *out* and *in* may point to the same
* area.
* *outbs=* the byte size (6 or 12) of the output chars.
* *table=* the address of the character set mapping
* table. this table has 1 entry per word,
* right justified with binary zero fill.
* (b1) = 1.
*
* exit the characters have been mapped.
*
* uses x - 1, 2, 6, 7.
* b - 2, 3, 4, 5.
* a - 1, 2, 6.
*
* calls sxs>, sxt>, txs>, or txt>.
purgmac mcs
mcs macroe in,inlen,out,inbs,outbs,table
r= b2,in
r= b3,inlen
r= b4,out
r= b5,table
ifeq inbs,6,2
^%s"mcs1 micro 1,, s
skip 4
ifeq inbs,12d,2
^%s"mcs1 micro 1,, t
skip 1
err input byte size must be 6 or 12.
ifeq outbs,6,2
^%s"mcs2 micro 1,, s
skip 4
ifeq outbs,12d,2
^%s"mcs2 micro 1,, t
skip 1
err output byte size must be 6 or 12.
rj =x'^%s"mcs1'x'^%s"mcs2'>
endm
xtxs space 4,10
*** xtxs provides an ftn callable link to the university of
* arizona twelvebit to sixbit character conversion routine.
*
* call xtxs(in,len,out,tbl)
*
* entry *in* is a variable or array containing the
* characters to be converted (5 per word).
* *len* is the word length of the array *in*.
* *out* is the variable or array to receive the
* converted characters (10 per word).
* *tbl* is an array containing the conversion table.
* this table contains 1 character per word,
* right justified, with binary zero fill.
*
* exit xtxs will return after doing the conversion.
*
* calls txs>.
xtxs subr entry/exit
sb1 1 and b1 shall be 1
sb2 x1 (b2) = input area address
sa1 a1+b1
sa2 x1
sb3 x2 (b3) = word length of input
sa1 a1+b1
sb4 x1 (b4) = output area address
sa1 a1+b1
sb5 x1 (b5) = conversion table address
mcs in=b2,inlen=b3,out=b4,table=b5,inbs=12,outbs=6
eq xtxs return
end
ident xvfn
entry xvfn
sst
syscom b1
title xvfn - validate file name.
comment (ftn) validate file name.
xvfn space 4,10
*** xvfn - validate file name.
*
* ans = xvfn (lfn)
*
* entry *lfn* = logical file name. trailing spaces will be
* deleted before name is validated.
*
* exit *ans* = 0 if file name is valid.
xvfn subr entry/exit
sb1 1
sb6 xvfna
sb7 b1
rj =xmfs> word align the lfn
sa1 xvfna
rj =xbtz> convert blanks to 00b
bx1 x6
rj =xvfn> check out the name
bx6 x1 set function value
eq xvfnx return
xvfna bss 1
end
ident retfile
sst
entry retfile,unlfile
syscom b1
retfile title retfile - return/unload a file.
comment return/unload a file.
space 4,10
*** retfile - return/unload a file.
*
* call retfile(lfn)
* call unlfile(lfn)
*
* entry lfn = a hollerith string or a character string
* containing the name of the file to be returned
* (retfile) or unloaded (unlfile). spaces are
* removed from lfn before processing.
*
* exit file is gone.
retfile space 4,10
** retfile - close/return a file.
retfile subr entry/exit
sb1 1 b1=1
rj sff set file name in fet
close retfilea,unload,rcl
eq retfilex return
unlfile space 4,10
** unlfile - close/unload a file.
unlfile subr entry/exit
sb1 1 b1=1
rj sff set file name in fet
close retfilea,unload,rcl
eq unlfilex return
sff space 4,10
** sff - set file name in fet.
*
* entry (x1) = ftn parameter pointer for lfn.
*
* exit (retfilea) contains lfn + complete bit.
*
* uses x - 1, 2, 6, 7.
* b - 2, 3, 4, 5, 6, 7.
* a - 2, 6.
*
* calls btz>, macwal=.
sff subr entry/exit
rj =xmacwal= get the file name
bx1 x2
rj =xbtz> delete any spaces
sa1 retfilea
sx1 b1
bx6 x6+x1 add complete bit
sa6 retfilea stash in fet
eq sffx return
retfilea vfd 42/**,18/1
con 100b first
con 100b in
con 100b out
con 101b limit
end