Trailing-Edge
-
PDP-10 Archives
-
decuslib10-13
-
podtyp.mac
There is 1 other file named podtyp.mac in the archive. Click here to see a list.
title podtyp
;
;program to output a file to a terminal in even parity 8-bit characters
;
sall
search uuosym,scnmac,macten
.request rel:scan,rel:helper
;
;for information regarding this program contact:
; Dr. Edmund West
; University of Toronto Computing Services
; 255 Huron St.
; Toronto, Ontario M5S 1A1
; (416-978-4085)
;
;version parameters
podver==1
podmin==1
podedt==1 ;first release, 9-Jun-82
podwho==0
;
;edit history
;
podedt==2 ;general clean up, symbol renames
podedt==3 ;add terminal types 1641 and 1620
podedt==4 ;make DIABLO be a 1620
podedt==5 ;fix reset escape sequences at FINISH
podedt==6 ;add <crlf> to error message macro EMSGCR
podedt==7 ;add dummy characters (bell) to reset sequence
;to force a possible active escape sequences to terminate
podedt==10 ;use terminating bell to let 1641 reset function complete
;
;end edit history
;
loc 137
byte (3)podwho(9)podver(6)podmin(18)podedt
twoseg
reloc 0
;
;conditional assembly parameters
;
nd ftdeb,0
if2<ifn ftdeb,<printx [debug version]>>
if2<ife ftdeb,<printx [production version]>>
;
;ac definitions
s==0 ;status bits
t1==1
t2==2
t3==3
t4==4
t5==5
t6==6
cc==10 ;character cache (double word)
cchigh==cc ;high order
cclow==cc+1 ;low order
mm==12 ;mask (double word)
mmhigh==mm ;high order
mmlow==mm+1 ;low order
p==17
;
; Define terminals, character strings and appropriate processors
;
; To add a terminal and its parameters insert a new term macro.
; The format of the term macro is as follows:
;
; term (name,code,<pcl>)
; where
; name =name of terminal
; code =unique 2-letter code for terminal type
; pcl =processor/character list (any number)
; =<proc1,chr1,<gcs1>>,<proc2,chr2,<gcs2>>,.....
; where
; proc =processing routine to be executed when a match occurs
; chr =character to trigger the test for a match
; gcs =groups of character strings to be tested (any number)
; =<cs1>,<cs2>,<cs3>,.....
; where
; cs =character string to be tested (up to eight characters)
; =c0,c1,c2,.....
;
; notes:
; (1) See the term macros under the ftdeb conditional for examples.
; (2) The angle brackets are required as shown (unless their contents
; are null). Thus, the characters in the test strings are nested
; four deep. It is very important to get them right.
; (3) Character strings are specified in reverse order. Thus, in example
; 'yy' below processor 'chk4' is executed when character string
; '210' (ie, octal 62, 61, 60) is encountered.
; (4) Characters may be specified symbolically or as 7- or 8-bit ascii.
; They are automatically converted internally to 8-bit ascii with parity.
; (5) Omitted positions in "cs" indicate any character is a match.
; (6) Scanning occurs from left to right. This will effect searches of
; strings under the same character, but for different processors.
; (7) If it exists, a routine named FIN<code> will be executed when terminal
; output is finished on terminal <code> (eg, routine FINDB will be
; executed when output to a DIABLO is finished).
; (8) The first entry under 'define trminl' will be the default terminal.
;
;continued on next page
;continued from previous page
define trminl<
term (diablo,db,<<ochr,c.ff,<<c.esc>,<c.ff,c.esc>,<c.ht,c.esc>,<c.vt,c.esc>,<c.rs,c.esc>,<c.us,c.esc>>>,<ffpro,c.ff>>)
term (1620,d2,<<ochr,c.ff,<<c.esc>,<c.ff,c.esc>,<c.ht,c.esc>,<c.vt,c.esc>,<c.rs,c.esc>,<c.us,c.esc>>>,<ffpro,c.ff>>)
term (1641,d4,<<ochr,c.ff,<<c.esc>,<c.ff,c.esc>,<c.ht,c.esc>,<c.vt,c.esc>,<c.rs,c.esc>,<c.us,c.esc>>>,<ffpro,c.ff>>)
term (tty,tt,<<pause,c.cy>,<ffpro,c.ff>>)
ifn ftdeb,<
term (v,vv)
term (w,ww,<<chk1,40>>)
term (x,xx,<<chk2,101,<<101,101>,<101,141>,<141,101>,<141,141>>>>)
term (y,yy,<<chk3,60,<<60>>>,<chk4,60,<<61,62>>>,<chk5,62,<<62,62,62,,,63,63,63>>>>)
term (z,zz,<<chk2,101,<<101,101>,<101,141>,<141,101>,<141,141>>>,<chk3,60,<<60>>>,<chk4,61,<<61,61>>>,<chk5,62,<<62,62,62,,,63,63,63>>>>)
>;end inf ftdeb
>;end define trminl
;
;define scan switches and values
;
define swtchs<
sn pause,psflg,fs.nos!fs.vrq!fs.nfs
sp start,strflg,.decnw##,str,fs.nfs
sl terminal,trmflg,trmk,pd.trm,fs.nfs
>
;see doscan, dm and trminl macros in high segment data area
;
;***********************************************************
;
;character processing dispatch and translation table macros
;
define chrs<
xlist
zz==0
repeat nasc,<
zx zz,ochr ;;character,,standard processing routine
zz==zz+1
>;end repeat
purge zz
list
>;end define chrs
;
;***********************************************************
;
;define macro to remove brackets from a set of arguments
;and pass them to another macro
;
define mpass2(m,a,b)<
m a,b
>;end define mpass2
;
;*******************************************************
;
;define macro to generate an 8-bit character with even parity
;
define ascii8(pn,n)<
zn==n
za==zn&177 ;;use 7 bits only
zb==zn&1+<zn&2>/2+<zn&4>/4+<zn&10>/10+<zn&20>/20+<zn&40>/40+<zn&100>/100
zc==<zb&1>*200 ;;make a parity bit (1 if zb is odd)
pn==za!zc ;;full odd parity ascii character
purge za,zb,zc,zn
>;end define ascii8
;
;define message macros
;
define msg(a),<
movei t1,[asciz\a\]
pushj p,.tstrg##
>
define msgcr (a),<
msg <a>
pushj p,.tcrlf##
>
;define error message macros
define emsg(a,b),<
msg <?POD'a >
msg <b>
>
define emsgcr (a,b),<
pushj p,.tcrlf##
emsg (<a>,<b>)
pushj p,.tcrlf##
>
;define error message subroutine macro
define errmsg (a,b),<
pushj p,[emsgcr(<a>,<b>)
popj p,]
>
;
;parameter definitions
;
;status bits
s.ccl==1 ;ccl entry
s.in==10 ;input file seen
s.inx==20 ;input file seen two or more times
s.out==100 ;output file seen
s.outx==200 ;output file seen two or more times
s.filb==s.inx!s.outx ;bad bits from file spec processing
s.ps==1000 ;pause bit (1=pause, 0=nopause)
s.ttyo==2000 ;controlling TTY same as output device
s.pgby==4000 ;page bypass in effect (waiting for start page)
s.term==10000 ;command and output terminal are same
s.keep==s.ccl ;bits to keep from one command to the next
s.clr==s.pgby!s.ttyo!s.ps!s.in!s.out ;bits to clear during .tscan init
s.tscn==s.filb ;bits to test after .tscan call
;
;value definitions
;
pdll==100 ;length of push down list
di==1 ;disk input channel
to==2 ;terminal output channel
sblkl==.fxlen ;length of scan block
oblkl==4 ;length of open block
lblkl==.rbsiz+1 ;length of lookup/enter block
nasc==200 ;number of ascii characters
mskofs==2 ;mask offset in string group table
chcnt0==^d50 ;characters output before checking for input
mn.str==1 ;minimum value for start switch
cc.shf==^d9 ;character cache shift count
;
;character codes
;
;7-bit definitions
c7.cc==3
c7.bel==7
;
;8-bit even parity definitions
;
ascii8 c.cc,c7.cc ;control-c
ascii8 c.bel,c7.bel ;bell
ascii8 c.ht,11 ;horizontal tab (control-I)
ascii8 c.lf,12 ;line feed
ascii8 c.vt,13 ;vertical tab (control-K)
ascii8 c.ff,14 ;form feed
ascii8 c.cr,15 ;return
ascii8 c.cy,31 ;control-y
ascii8 c.cz,32 ;control-z
ascii8 c.esc,33 ;escape
ascii8 c.rs,36 ;record separator (control-hat)
ascii8 c.us,37 ;unit separator (control-underline)
ascii8 c.spc,40 ;space
ascii8 c.xp,120 ;upper case p
;
;data storage
;
pdl: block pdll ;push down list
scnflg: ;scan flags (keep together)
psflg: block 1 ;pause flag (for scan)
strflg: block 1 ;start flag
trmflg: block 1 ;terminal flag
scnfll==.-scnflg
scnval: ;scan switch values (keep together)
psval: block 1 ;pause value
strval: block 1 ;start value (first page to be output)
trmval: block 1 ;terminal value (index)
scnvll==.-scnval
if2< ifn scnfll-scnvll,<printx ?flag and value block sizes not equal>>
optval: block scnfll ;space to remember options file values
pagcnt: block 1 ;page counter (page in progress)
chrcnt: block 1 ;character counter (triggers input check)
udxcom: block 1 ;udx of command terminal
udxout: block 1 ;udx of output device
iblk: block 6 ;iscan data
iblkl=.-iblk
tblk: block 11 ;tscan data
tblkl=.-tblk
oblk: block 5 ;oscan data
oblkl=.-oblk
sblki: block sblkl ;scan block for input file
oblki: block 4 ;open block for input file
bcbdi: block 3 ;disk input buffer control block
lblki: block lblkl ;lookup block for input file
pblki: block .ptmax ;path block for input file
sblko: block sblkl ;scan block for output file
oblko: block 4 ;open block for output file
bcbto: block 3 ;terminal output buffer control block
bcbti: block 3 ;terminal input buffer control block
lblko: block lblkl ;enter block for output file
pblko: block .ptmax ;path block for output file
chrtab: block nasc ;character translation/dispatch table
;
;execution
;
reloc 400000
podtyp::
tdza s,s ;clear status
movei s,s.ccl ;ccl entry
reset
move p,[iowd pdll,pdl] ;set up push down list
outstr [asciz\[PODTYP, /H for help]\]
ifn ftdeb,<
outstr [asciz\ [DEBUG version]\]
>;end ftdeb
pushj p,.tcrlf##
movsi t1,'tty' ;get udx of controlling terminal
iondx. t1,
jrst [emsgcr EUT,<Error getting UDX of TTY>
exit 1,]
movem t1,udxcom ;save it
reset
move p,[iowd pdll,pdl] ;set up push down list
;set up blocks for .iscan
move t1,[xwd iblkl,iblk] ;set up for scanning
pushj p,.iscan##
;initialize all switch values to default values
movei t1,ad.str ;start switch
movem t1,strval
movei t1,ad.trm ;terminal switch
movem t1,trmval
movei t1,ad.ps ;pause switch
movem t1,psval
;set up blocks for .oscan
pushj p,iniflg ;initialize switch flags
move t1,[iowd swt..l,swt..n] ;set up for oscan switchs
movem t1,oblk
move t1,[xwd swt..d,swt..m]
movem t1,oblk+1
move t1,[xwd 0,swt..p]
movem t1,oblk+2
move t1,[sixbit\podtyp\] ;set help file and option name
movem t1,oblk+3
movem t1,oblk+4
move t1,[xwd oblkl,oblk] ;scan options file
pushj p,.oscan##
pushj p,setswt ;process these switches
move t1,[xwd scnval,optval] ;remember values from options file
blt t1,optval+scnvll-1
;
; main program loop
;
go:
reset ;clear everything again
move p,[iowd pdll,pdl] ;set up push down list again
move t1,[xwd optval,scnval] ;set up options values again
blt t1,scnval+scnvll-1
movei t1,c.cr ;output a carraige return
pushj p,.tchar##
;set up blocks for .tscan
move t1,[iowd swt..l,swt..n] ;set up for scan switchs
movem t1,tblk
move t1,[xwd swt..d,swt..m]
movem t1,tblk+1
move t1,[xwd 0,swt..p]
movem t1,tblk+2
move t1,[sixbit\podtyp\] ;help file name
movem t1,tblk+3
move t1,[xwd clra,0] ;clear all answers
movem t1,tblk+4
move t1,[xwd alli,allo] ;scan block allocation routines
movem t1,tblk+5
movei t1,fs.mot ;allow multiple output file specs
hrrm t1,tblk+7 ;(to cause error if no equal sign)
move t1,[xwd tblkl,tblk] ;scan command line
pushj p,.tscan##
trne s,s.tscn ;was an error detected?
jrst [trne s,s.inx ;extra input files?
errmsg XIF,Extra input files
trne s,s.outx ;extra output files?
errmsg XOF,Extra output files
jrst go]
;no error, fall through to process the command
;process the command
setzb cclow,cchigh ;clear character cache
pushj p,setswt ;set up switch values
skipe psval ;is pause in effect (ie, psval=1)?
tro s,s.ps ;yes, set pause bit
;set up the page counter
setzm pagcnt ;initialize page counter
tro s,s.pgby ;and page bypass bit
movei t1,chcnt0 ;initialize character counter
movem t1,chrcnt
;set up dispatch table according to this terminal's special character list
move t1,[xwd xchrtb,chrtab] ;initialize dispatch table
blt t1,chrtab+nasc-1
movei t4,chrpro ;address of special handling routine
move t3,trmval ;terminal type
move t2,trmlst-1(t3) ;pointer to special character table
chrlp:
aobjp t2,chrlpx ;if not last, point to next entry
ldb t1,[point 7,(t2),17] ;get 7-bits of special character
add t2,[xwd 1,1] ;adjust pointer to special characters
hrrm t4,chrtab(t1) ;change dispatch for special characters
jrst chrlp ;get next entry
chrlpx:
;get input file spec
trne s,s.in ;did alli get called?
skipn sblki+.fxnam ;yes, did user specify input file?
jrst [emsgcr IFR,Input file required
jrst go]
move t2,[xwd 'pod',-1] ;default extension and mask
hrrz t1,sblki+.fxext ;get input extension
skipn t1 ;was it specified by user?
movem t2,sblki+.fxext ;no, use default
move t1,[xwd sblkl,sblki] ;set up input blocks
movei t2,oblki
move t3,[xwd .rbsiz,lblki]
movei t4,pblki
pushj p,.stopb##
jrst [emsgcr IIF,Illegal input file specification
jrst go]
;get output file spec
trne s,s.out ;did allo get called?
skipn sblko+.fxdev ;yes, was device specified?
jrst [movsi t1,'tty' ;no, use default device
movem t1,sblko+.fxdev
setzm t1,sblko+.fxnam ;use blank name
setom sblko+.fxnmm ;use full mask
movei t1,-1 ;use blank extension, full mask
movem t1,sblko+.fxext
jrst .+1]
move t1,[xwd sblkl,sblko] ;set up output blocks
movei t2,oblko
move t3,[xwd .rbsiz,lblko]
movei t4,pblko
pushj p,.stopb##
jrst [emsgcr IOF,Illegal output file specification
jrst go]
;initialize input file
movei t1,bcbdi ;disk input buffer control block
hrrm t1,oblki+.opbuf
movei t1,.ioasc ;ascii mode input
movem t1,oblki+.opmod
open di,oblki ;open device
jrst [emsg IOE,<Input open error for >
jrst inerr]
movei t1,.rbsiz ;last word of lookup block
movem t1,lblki
lookup di,lblki ;lookup file
jrst [emsg ILE,<Input lookup error (>
hrrz t1,lblki+.rbext
pushj p,.toctw##
msg <) for >
jrst inerr]
;check output device capabilities
move t1,oblko+.opdev ;get udx of output device
iondx. t1,
jrst [emsg CGU,<Cannot Get UDX for >
jrst outerr]
movem t1,udxout ;remember it
camn t1,udxcom ;is it same as controlling tty?
tro s,s.ttyo ;yes, set bit
devchr t1,
jumpe t1,[emsg IOD,<Illegal Output Device for >
jrst outerr] ;illegal device
trnn t1,dv.m2 ;can device do PIM i/o?
jrst [emsg IOM,<Illegal Output Mode for >
jrst outerr]
;if debugging, tell user what's happening
ifn ftdeb,<
msg <[>
movei t1,oblko
movei t2,lblko
pushj p,.toleb##
msg <=>
movei t1,oblki
movei t2,lblki
pushj p,.toleb##
movei t1,[asciz ./NOPAUSE.]
trne s,s.ps
movei t1,[asciz ./PAUSE.]
pushj p,.tstrg##
movei t1,[asciz ./START:.]
pushj p,.tstrg##
move t1,strval
pushj p,.tdecw##
movei t1,[asciz ./TERMINAL:.]
pushj p,.tstrg##
move t1,trmval
move t1,trmk.t-1(t1)
pushj p,.tsixn##
msgcr <]>
>;end ftdeb
;initialize output file
pushj p,owait ;wait for device to finish output
hrli t1,bcbto ;terminal i/o buffer control blocks
movem t1,oblko+.opbuf
movei t1,.iopim ;packed image mode output
movem t1,oblko+.opmod
open to,oblko ;open device
jrst [emsg OOE,<Output open error for >
jrst outerr]
movei t1,.rbsiz ;last word of enter block
movem t1,lblko+.rbcnt
enter to,lblko ;enter file
jrst [emsg OEE,<Output enter error (>
hrrz t1,lblko+.rbext
pushj p,.toctw##
msg <) for >
jrst outerr]
;check terminals
move t1,udxcom ;commmand terminal
camn t1,udxout ;same as output terminal?
tro s,s.term ;yes, remember
;clear PIM break set to force character mode input
move t2,[xwd 3,t3]
movei t3,.toset+.topbs
move t4,udxout
setz t5,
trmop. t2,
jrst [emsgcr CSP,<Cannot Set PIM break set>
jrst go]
;prepare for data transmission
pushj p,newpag ;prepare for first page
pushj p,fpause ;force an initial pause
;
;main i/o loop
;
loop:
sosl t1,chrcnt ;count character, check for input?
jrst loop1 ;no, proceed
movei t1,chcnt0 ;yes, reset counter
movem t1,chrcnt
pushj p,gtinp ;any input?
jrst loop1 ;no, proceed
cain t1,c.cc ;yes, was it control-c?
jrst quit ;yes, abort
loop1:
pushj p,ichr ;get next character
jrst indone ;reached end of file
move t2,chrtab(t1) ;get dispatch word
ldb t1,[point 8,t2,17] ;get even parity version of character
push p,t1 ;save character
pushj p,(t2) ;dispatch to character processor
;
; do character processing (including output), finish with normal return
;
pop p,t1 ;retrieve character
lshc cc,cc.shf ;shift cache
iorm t1,cclow ;insert most recent character
jrst loop ;now get next character
;
;here when i/o is completed
;
indone:
;data transfer is complete
pushj p,fpause ;force a finishing pause
pushj p,finish ;do normal finish stuff
jrst go ;set up to do it all again
;
;routine to read input file
;
ichr:
sosge bcbdi+.bfctr ;anything in buffer?
jrst filbuf ;no, fill it up
ildb t1,bcbdi+.bfptr ;yes, get next character
jrst cpopj1 ;skip return to caller
filbuf:
in di, ;fill the buffer
jrst ichr ;and try again
stato di,io.err ;skip if a real error
popj p, ;non-skip return on end of file
;here on i/o error
emsg IER,<Input Error for >
jrst inerr
;
;routine to write output device
;
ochr:
trne s,s.pgby ;page bypass on?
popj p, ;yes, no output
fochr: ;here to force output into the buffer
sosge bcbto+.bfctr ;room in buffer?
jrst bufful ;no, empty it
idpb t1,bcbto+.bfptr ;yes, output next character
popj p, ;return to caller
bufful:
out to, ;output the buffer
jrst fochr ;and try again
;here on i/o error
emsg OER,<Output Error for >
jrst outerr
;
;routine to process special characters
;
chrpro:
move t6,trmval ;terminal type
move t6,trmlst-1(t6) ;point to character/processor table
chrchk:
aobjp t6,ochr ;if end of list, process normally
hlrz t2,(t6) ;get next possible character
add t6,[xwd 1,1] ;adjust counter
came t2,t1 ;characters match?
jrst chrchk ;no, try next
;here to test strings
skipl t5,(t6) ;load/check string group pointer
jrst match ;match, if no strings specified
strchk:
aobjp t5,chrchk ;if no more strings, try next character
dmove t3,(t5) ;(t3,t4)=possible string
dmove mm,mskofs(t5) ;string mask
add t5,[xwd 3,3] ;adjust counter
and mmlow,cclow ;retain interesting low characters
came t4,mmlow ;same as actual?
jrst strchk ;no, try next string
and mmhigh,cchigh ;yes, retain interesting high characters
came t3,mmhigh ;same as actual?
jrst strchk ;no, try next string
;here if found a full match
match:
hrrz t6,-1(t6) ;address of actual processor
pushj p,(t6) ;do special processing
popj p, ;return without storing character
pjrst ochr ;store character and return
;
;routine to do final clean up
;
finish:
move t1,trmval ;get terminal number
pushj p,@fintab-1(t1) ;execute terminal-dependent code
releas di, ;release input
releas to, ;release output
popj p,
;
;routine to quit program
;
quit:
pushj p,clrout ;clear output buffers
pushj p,finish ;do special finishing things
pushj p,.tcrlf## ;extra CRLF
emsgcr PEA,<Program Execution Aborted>
jrst go ;and accept next command
;
;routine to handle form feeds
;
ffpro:
trnn s,s.ps ;pause on?
pushj p,ochr ;no, send form feed (if ochr allows)
pushj p,pause ;wait for user (if pause allows)
;fall through to count new page
;
;routine to count up new pages
;
newpag:
aos t2,pagcnt ;count next page
camn t2,strval ;at start value?
trz s,s.pgby ;yes, clear page bypass bit
popj p,
;
;routine to pause until user types a bell on one of the terminals
;
pause:
trne s,s.ps ;pause off?
trne s,s.pgby ;no, page bypass on?
popj p, ;yes, do not pause
fpause: ;here to force a pause
pushj p,belsnd ;send bell to signal waiting
pushj p,belwat ;wait for user to type bell
popj p,
;
;routine to send bell to user's terminal (both terminals, if different)
;
belsnd:
movei t1,c.bel ;get bell
pushj p,fochr ;force it into the output buffer
out to, ;send it
trnn s,s.term ;are terminals the same?
outchr t1 ;no, send it to command terminal also
popj p,
;
;routine to wait for user input from either terminal
;a bell is the signal to continue
;a control-C is the signal to quit
;all other characters are ignored
;(but echoed if they came from the output device)
;
belwat:
pushj p,clrinp ;clear input buffers
belhib:
movsi t1,(hb.rtc) ;wait for input from either terminal
hiber t1,
halt
belwt1:
pushj p,gtinp ;any input?
jrst belhib ;no, wait some more
cain t1,c.cc ;yes, control-c?
jrst quit ;yes, abort
came t3,udxout ;did this come from output device?
jrst belwt2 ;no, skip echoing
pushj p,ochr ;yes, echo the character
out to, ;do it now
belwt2:
cain t1,c.bel ;bell?
popj p, ;yes, return
jrst belwt1 ;no, see if any more
;
;routine to read a character from either the output device or command terminal
;
;non-skip return if nothing typed
;skip return with t1 = 8-bit character, t3 = udx of active device
;
gtinp:
movei t2,.tosip ;check input in progress
move t3,udxout ;for output terminal
move t1,[xwd 2,t2]
trmop. t1, ;is it?
jrst gtinp1 ;no, try command terminal
movei t2,.toisc ;yes, read character from output device
trmop. t1,
halt ;should never happen
jrst gtinp2 ;process character
gtinp1: ;here to check command terminal
trnn s,s.term ;are the terminals different?
inchrs t1 ;yes, was a character typed?
popj p, ;same terminal or no input
gtinp2:
ldb t1,[point 8,chrtab(t1),17] ;convert to 8-bit even parity
jrst cpopj1 ;skip return
;
;routine to clear terminal input buffers
;
clrinp:
move t1,[xwd 2,t2]
movei t2,.tocib ;clear input buffer
move t3,udxout ;for output device
trmop. t1,
jfcl
trne s,s.term ;same terminal as output?
popj p, ;yes, done
move t3,udxcom ;no, now for commmand terminal
trmop. t1,
jfcl
popj p,
;
;routine to clear terminal output buffers
;
clrout:
move t1,[xwd 2,t2]
movei t2,.tocob ;clear output buffer
move t3,udxout ;for output device
trmop. t1,
jfcl
trne s,s.term ;same terminal as output?
popj p, ;yes, done
move t3,udxcom ;no, now for commmand terminal
trmop. t1,
jfcl
popj p,
;
;routine to do diablo-dependent finish stuff
;
findb:
find2:
skipa t2,[point 8,clrd2] ;pointer to clean up string
find4:
move t2,[point 8,clrd4]
findb1:
ildb t1,t2 ;get character
jumpe t1,cpopj ;if null, quit
pushj p,ochr ;output it
jrst findb1 ;get next one
clrd4: byte (8)c.bel,c.bel,c.esc,c.cr,c.xp,c.bel,0
clrd2: byte (8)c.bel,c.bel,c.esc,c.us,c.cr,c.esc,c.rs,c.ht,0
;routine to let output device complete any pending i/o
;so data is not affected by changing the output mode
owait:
move t3,udxout ;udx of output device
movei t2,.tooip
owait1: move t1,[xwd 2,t2] ;is output still in progress?
trmop. t1,
jrst [emsgcr TUE,<TRMOP. UUO Error>
jrst go]
jumpe t1,cpopj ;done if bit zero
movei t1,1 ;sleep a while
sleep t1,
jrst owait1 ;try again
;
;allocate space for input file specification
alli:
troe s,s.in ;seen before?
tro s,s.inx ;yes, remember
setzm sblki ;no, clear input scan block
move t1,[xwd sblki,sblki+1]
blt t1,sblki+sblkl-1
movei t1,sblki ;scan block for input file
movei t2,sblkl
popj p,
;
;allocate space for output file specification
allo:
troe s,s.out ;seen before?
tro s,s.outx ;yes, remember
setzm sblko ;no, clear output scan block
move t1,[xwd sblko,sblko+1]
blt t1,sblko+sblkl-1
movei t1,sblko ;no, get scan block for output file
movei t2,sblkl
popj p,
;
;clear all answers
;
clra:
andi s,s.ccl ;clear most status bits
pushj p,iniflg ;initialize switch flags
;clear scan blocks for .tscan and .stopb processing
setzm sblki ;clear input scan block
move t1,[xwd sblki,sblki+1]
blt t1,sblki+sblkl-1
setzm sblko ;clear output scan block
move t1,[xwd sblko,sblko+1]
blt t1,sblko+sblkl-1
popj p,
;
;routine to initialize switch flags
;
iniflg:
setom scnflg ;initialize all scan flags
move t1,[xwd scnflg,scnflg+1]
blt t1,scnflg+scnfll-1
popj p,
;
;routine to process switches if specified by user
;
setswt:
;start switch
skipge t1,strflg ;was starting value specified?
jrst setsw1 ;no, ignore it
caig t1,mx.str ;yes, is value too large?
caige t1,mn.str ;no, is it too small?
jrst [emsgcr IVS,<Illegal Value for START switch, ignored>
jrst setsw1]
movem t1,strval ;use it
setsw1:
;terminal switch
skiple t1,trmflg ;was terminal specified by user?
movem t1,trmval ;yes, use it
;pause switch
skipl t1,psflg ;was pause switch specified?
movem t1,psval ;yes, use it
popj p,
;
;type file error message and restart program
;
inerr:
movei t1,oblki ;open block for input file
movei t2,lblki ;lookup block for input file
jrst filerr
outerr:
movei t1,oblko ;open block for output file
movei t2,lblko ;lookup block for output file
filerr:
pushj p,.toleb##
pushj p,.tcrlf##
clrbfi
jrst go
;
;special locations
store: ;special handling routine to store
cpopj1: aos (p)
ignore: ;special handling routine to ignore character
cpopj: popj p,
;
ifn ftdeb,<
chk1: jrst cpopj1
chk2: jrst cpopj1
chk3: jrst cpopj1
chk4: jrst cpopj1
chk5: jrst cpopj1
chk6: jrst cpopj1
chk7: jrst cpopj1
chk8: jrst cpopj1
chk9: jrst cpopj1
>;end ifn ftdeb
;
;generate prototype translation and dispatch table
;(copied to low segment and adjusted at time of command execution)
;
define zx(n,addr)<
ascii8 zpc,n
byte (10)0(8)zpc(18)addr ;;bits, character, dispatch address
purge zpc
>;end define zx
xchrtb: chrs
;
;set up for scan switch processing
doscan (swt..)
;
;*******************************************
;
;define terminal types
;
;generate keyword table for terminal types
;(this is a substitute for scan's "keys" macro)
;
define term(nm,cd,pl)<
sixbit \nm\
>;end define term
;
trmk.t: trminl
trmk.l==.-trmk.t
;
;*******************************************
;
;define check values
;
dm trm,trmk.l,1,1
dm str,^d9999,1,1
dm ps,1,1,1
;
;*******************************************
;
;generate pointers to special processor tables
;
define term(nm,cd,pl)<
iowd prl%'cd,pra%'cd
>;end define term
;
trmlst: trminl
;
;*******************************************
;
;generate pointers to terminal-dependent finishing routines
;
define term(nm,cd,pl)<
if2<ifndef fin'cd,<fin'cd==cpopj>>
xwd 0,fin'cd
>;end define term
fintab: trminl
;
;generate character list with pointer to processor and string groups
;
define term(nm,cd,pl)<
pra%'cd:
zz==0
irp pl,<
;
define item(in,ipr,ich,ics)<
if2<ifb <ich>,<printx ?Missing character for code cd and processor ipr>>
ascii8 ipch,ich
byte (10)0(8)ipch(18)ipr
iowd gl'cd''in,g%'cd''in
>;end define item
;
mpass2 item,\zz,pl
zz==zz+1
>;end irp pl
prl%'cd==.-pra%'cd
>;end define term
;
trminl
;
;character string tables for the various processor/character combinations
;
define term(nm,cd,pl)<
zz==0
irp pl,<
;
define item(in,ipr,ich,ics)<
;
define tstr(ch0,ch1,ch2,ch3,ch4,ch5,ch6,ch7,chx)<
if2<ifnb <chx>,<printx ?Character string too long for terminal nm, processor ipr, character ich>>
ifb <ch0>,<mk0==0>
ifnb <ch0>,<mk0==-1>
ifb <ch1>,<mk1==0>
ifnb <ch1>,<mk1==-1>
ifb <ch2>,<mk2==0>
ifnb <ch2>,<mk2==-1>
ifb <ch3>,<mk3==0>
ifnb <ch3>,<mk3==-1>
ifb <ch4>,<mk4==0>
ifnb <ch4>,<mk4==-1>
ifb <ch5>,<mk5==0>
ifnb <ch5>,<mk5==-1>
ifb <ch6>,<mk6==0>
ifnb <ch6>,<mk6==-1>
ifb <ch7>,<mk7==0>
ifnb <ch7>,<mk7==-1>
ascii8 pch0,ch0
ascii8 pch1,ch1
ascii8 pch2,ch2
ascii8 pch3,ch3
ascii8 pch4,ch4
ascii8 pch5,ch5
ascii8 pch6,ch6
ascii8 pch7,ch7
byte (9)pch7,pch6,pch5,pch4,pch3,pch2,pch1,pch0
byte (9)mk7,mk6,mk5,mk4,mk3,mk2,mk1,mk0
purge pch0,pch1,pch2,pch3,pch4,pch5,pch6,pch7
purge mk0,mk1,mk2,mk3,mk4,mk5,mk6,mk7
>;end define tstr
;
g%'cd''in:
irp ics,<
;
define tx(txcl)<
tstr txcl
>;end define tx
;
tx ics
>;end irp ics
gl'cd''in==.-g%'cd''in
>;end define item
;
mpass2 item,\zz,pl
zz==zz+1
>;end irp pl
purge zz
>;end define term
;
trminl
end podtyp