Trailing-Edge
-
PDP-10 Archives
-
decuslib10-07
-
43,50433/pasio.mac
There are 4 other files named pasio.mac in the archive. Click here to see a list.
TITLE PASIO *** RUNTIME SUPPORT FOR PASCAL PROGRAMS ***
;Edit history - begins suddenly with edit 2 - no version number is
; used, since it can't go in a library file anyway (it would override
; the version number of the main program).
;2 - make it run under tenex and tops-20, so we can bootstrap and test the
; system on Tops-20 using the emulator. the problem is the page. UUO
;3 - fix computation of number of buffers in updat1. This is probably
; the mysterious CSL patch that didn't get in the master source.
; code was total garbage before
;4 - make the default Tops-10 in case of an old .rel file that doesn't
; call pasim. Make mon.tp internal so other routines can check
;5 - =2 in tops20 pasnum.mac - implement break set in string read
;6 - =3 in tops20 pasnum.mac - make real numbers read in have same
; representation as compiled
;7 - prevent finding arithmetic errors in runtimes
;10 - fix bug in counting destination in readps
;11 - detect wraparound in corerr
;12 - use tops-20 table-driven strategy for GETCH
;13 - fix readps for version 106 compiler PACKED ARRAY OF CHAR
;14 - do clrbfi on fatal errors
;15 - =7 in tops20 pasnum.mac - make real number reader read exact fractions exactly
;16 - allow user to enable for end of tape
;17 - retrofit to KA
;20 - add DELETE
;21 - fix to real number reader, =12 in tops-20 pasnum.mac
;Version 2 - reorganize to be table-driven along the lines of the Tops-20
; implementation.
;22 - fix chkmta to clear LH bit
;23 - changed error handling around to keep from clearing the rest of the
; record when get EOF in the middle of a record. This required changing
; most of the error routines, to have skip/no-skip returns instead of
; aborting the caller (which was a bad idea anyway)
;24 - moved LSTREC to XIO
;25 - move fndchn and loschn to separate module, for Fortran interface
;26 - add support for DISPOSE
;27 - fixes to random access
;30 - typo in PUTU
;31 - set page-modified flag after IDPB, not before (be sure on right page!)
;32 - at putcu, fix skip that skiped into error code
;33 - block number off by one on files being written
;34 - clean up defn of breakin
;35 - fix NEWCL. Roles of AC 1 and 2 had been reversed
TWOSEG 400000
if1, <printx TOPS-10 version>
;ENTRY POINTS
entry initb.,init.b,gotoc.,dispc.,ilfil.
ENTRY LSTNEW,NEWBND,PASIN.,PASIM.,PASIF.
entry getchn
entry relchn
entry curchn
entry analys,upcase
ENTRY CORERR,DCORER
entry endl,runer.
ENTRY GETNEW,NEWCL.
ENTRY END,QUIT
ENTRY GETLN
ENTRY GET.,GETX.
ENTRY PUTLN
ENTRY PUT,PUTX
ENTRY RESETF
ENTRY REWRIT
entry rename,resdev,update
repeat 0,<
entry dumpin,dumpou,usetin,usetou
>
entry delf.
entry append
ENTRY BREAK,BREAKIN
ENTRY TTYOPN
ENTRY INXERR
ENTRY PTRER.
ENTRY PUTPG
ENTRY GETCH
ENTRY SRERR
ENTRY CLOFIL,rclose
entry curpos,setpos
intern brkdn.,mon.tp
intern geter.
intern in.ddt,erend,in.crt
intern norcht,illfn,norchx
intern in.use
EXTERN PARSE,fn.chn,lo.chn,enterc,leavec
;registers and file block
search pasunv,uuosym
ifn ka10sw,<
intern wrk.sz
> ;ifn ka10sw
;ADDRESSES
EXTERNAL .JBDDT,.JBFF,.JBSA
;constants
maxeof==10
%close==close ;These are because of MACRO10 bugs
%useto==useto
%setsts==setsts
%out==out
%wait==<calli 10>
%mtape==mtape
%rename=055000000000
subttl memory allocation routines
;START OF RUNTIME-SUPPORT'S CODE
;
;*** FEHLER BEI STOREOVERFLOW
;
;memory structure:
; I/O buffers are at .JBFF, maintained by monitor
; NEW area is just below 400000, maintained by NEW routine.
; LSTNEW is address of last location used by NEW
; NEWBND is lowest address NEW can use without getting core
; stack and heap is above hiseg code, maintained by CORERR
; ac 15 points to highest address available to stack without new core
; (Note that ac 15 used to be LSTNEW, in effect, and so is called NEWREG)
;
;about reentrancy:
; We intend to implement PSI interrupts eventually, so some care has
; gone into making sure this code can all be interrupted. If NEW
; or CORERR are interrupted at the wrong time, certain things can
; be needlessly redone, but it should work. Note that if the
; interrupting process expands core during an interrupt in NEW or
; CORERR, there can be more core than we thought, and the PAGE. UUO
; will fail (as the page requested already exists. This should be
; OK.) Also note that if the interrupter does NEW or CORERR,
; stkexp+1 can be different after the PAGE. than we set it. However,
; that should cause no trouble. There is also a problem with I/O.
; An interrupt process may not use the same file used by the main prog,
; as there would be conflict in accessing the file block. The state of
; the TTY file should be saved and restored to allow this to be relaxed.
;assumptions about interrupt process:
; ac 17, the PDL pointer, it returned to where it was before
; ac 15, the highest avail hiseg address, may be increased if more
; core is gotten during the interrupt
; newbnd and lstnew may be decreased if NEW is done during the
; interrupt. Note that NEW is coded so this should cause no
; trouble.
; if I/O is done, all channels are closed, so that INUSE is restored.
; This is necessary in case we are interrupted at a bad time during
; GETCHN. We should make GETCHN more clever, to relax this.
; AC's other than 15 and 17 must be saved and restored by the
; interrupt
w==14 ;[11] be careful - AC not usually free in runtimes - just at block entry time
ife ka10sw,< ;[17]
dcorer: move w,ac0 ;[11] desired location
caige w,(basis) ;[11] wraparound ?
jrst cordon ;[11] yes - done for
jrst corerl ;[11] enter main corget loop
corerr: hrrz w,-2(ac1) ;[11] addr field of CAIG before call
addi w,(p) ;[11] i.e. add rh(p) - addr field is offset from stack
corerl: camge w,newreg ;[11] do we have it?
jrst (ac1) ;yes - return
move ac0,newreg ;highest we have
lsh ac0,-11 ;get page number
addi ac0,1 ;get a new page
caile ac0,776 ;see if about to overwrite PFH
jrst cordon ;we're done for
hrrm ac0,stkexp+1 ;and save for page. UUO
;[2] ready for page. see if need to simulate for tops-20 or tenex
move ac0,mon.tp ;[2] get monitor type
repeat 0,< ;this code uses a simulation of the page. UUO. It works, but
;at the moment we prefer to have initialization do a CORE UUO
;that allocates all of memory
cain ac0,4 ;[2] tops-20
jrst cor20 ;[2] requires real simulation
> ;repeat 0
caie ac0,1 ;[2] tops-10 will continue for page.
jrst corsuc ;[2] others (tenex?) create on reference
;[2] code to do page. for tops-10
hrli ac0,1 ;create a page
hrri ac0,stkexp ;address spec
page. ac0,
jrst corfai ;page may already exist, if restarted, or interrupted
;between the camge and here
corsuc: move ac0,stkexp+1 ;may be larger than what we put there
;if we were interrupted
lsh ac0,11 ;make an address
tro ac0,777 ;highest in page is OK
move newreg,ac0 ;and make it highest legal
jrst corerl ;[11] now see if need still more
corfai: cain ac0,3 ;page already exists
jrst corsuc ;pretend we succeeded
caie ac0,12 ;over cormax
jrst cordon ;some other problem
move ac0,stkexp+1 ;the page being created
tloe ac0,200000 ;specify on disk?
jrst cordon ;then we can't do anything
movem ac0,stkexp+1 ;try again on disk
jrst corerl ;[11] bypass success code
> ;ife ka10sw
ifn ka10sw,< ;[17]
corerr:
dcorer:
> ;ifn ka10sw
cordon: outstr [asciz /
? No memory for stack/]
jrst erend
ife ka10sw,<
repeat 0,<
;At the moment we don't need this routine, because we do an initial
;CORE UUO to assign all of memory
;[2] routine to simulate page. UUO for tops-20. Just have to access a word
;[2] on the new page to get the monitor to create it. But the emulator
;[2] has set up a trap for such cases to allow it to catch ill mem ref's.
;[2] this trap must be turned off before we create and then back on.
cor20: hrl 16,1 ;[2] save ac 1 (lh 16 is redundant)
move 0,2 ;[2] save ac 2
movei 1,400000 ;[2] current process
movei 2,1b22 ;[2] nxm interrupt
104000,,133 ;[2] dic - disable interrupt
hrrz 2,stkexp+1 ;[2] get page to be created
lsh 2,11 ;[2] turn into address
move 2,(2) ;[2] access it
movei 2,1b22 ;[2] now enable interrupt again
104000,,131 ;[2] aic - enable interrupt
hlrz 1,16 ;[2] restore ac's
hrl 16,16 ;[2]
move 2,0 ;[2]
jrst corsuc ;[2] finished with simulation
> ;repeat 0
;
;*** INLINEPROCEDURE NEW
;
getnew: movn ac1,reg ;must change lstnew and read it in same
;instruction if we are to be interrupted
addb ac1,lstnew ;subtract length asked for from lstnew
CAIN ac1,377777 ;IF NIL, COULD CAUSE TROUBLE - TRY AGAIN
JRST NEWNIL
caml ac1,.jbff ;see if there is room
;USE OF STACK BY RUNTIME SUPPORT
JRST . +3
ADDI ac1,(REG)
JRST NEWERR ; MOVEI REG,^O377777
newlop: caml ac1,newbnd ;is memory there?
JRST NEWXIT ;YES - DONE
move ac0,newbnd ;get lowest we have
lsh ac0,-11 ;make page number
subi ac0,1 ;and get next
hrrm ac0,heaexp+1 ;page request
;[2] ready for page. UUO. call emulations if not tops-10
move ac0,mon.tp ;[2] get monitor type code
repeat 0,< ;At the moment we don't need this code, because we do an
;initial CORE UUO to allocate all of memory
cain ac0,4 ;[2] if tops-20, need real simulation
jrst new20 ;[2]
> ;repeat 0
caie ac0,1 ;[2] if tops-10, continue into page.
jrst newsuc ;[2] else (tenex) assume reference creates
;[2] do page. UUO
hrli ac0,1 ;create a page
hrri ac0,heaexp
page. ac0,
jrst newfai
newsuc: move ac0,heaexp+1 ;page we created (usually)
lsh ac0,11 ;turn into address
movem ac0,newbnd ;lowest legal
jrst newlop ;see if we need more
> ;ife ka10sw
newnil: caig reg,0 ;here if would return NIL
movei reg,1 ;if size=0, use 1, or get a loop
jrst getnew ;and throw away this block
ifn ka10sw,< ;[17]
getnew: movn ac1,reg ;crazy code to prevent race
addb ac1,newreg ;so can set both in one operation
caige ac1,(p) ;complain if overlapped stack
jrst newerr
CAIN ac1,377777 ;IF NIL, COULD CAUSE TROUBLE - TRY AGAIN
JRST NEWNIL
jrst newxit
> ;ifn ka10sw
;[35] reverse roles of A and B after call to NEW, and remove the
;call to newxit, which had been used to put the data back into B
NEWCL.: PUSH P,REG
PUSHJ P,NEW## ;ENTRY IF TYPECHECKING
pop p,a
jumple a,cpopj ;set new place to zero - ignore if none
setzm (b) ;set first loc to zero
sojle a,cpopj ;if no more, stop
add a,b ;a _ last loc in block
hrli ac0,(b)
hrri ac0,1(b)
blt ac0,(a) ;clear block
popj p,
newxit: MOVE REG,ac1
POPJ P,
ife ka10sw,<
newfai: cain ac0,3 ;page already existed
jrst newsuc ;pretend we succeeded
caie ac0,12 ;no room in core
jrst newerr ;something else wrong
move ac0,heaexp+1 ;get page to be created
tloe ac0,200000 ;on disk?
jrst newerr ;yes - can't help him
movem ac0,heaexp+1 ;try again on disk
jrst newlop ;skip success code and try again
> ;ife ka10sw
NEWERR: OUTSTR [ASCIZ /
? No memory for heap/] ;Need new message
move ac0,(p) ;PC to print
pushj p,runer. ;print PC and go to debugger
movei reg,377777 ;return nil if continues
popj p,
;various file cleanup stuff:
;gotoc. - cleanup for goto
; b - new o
; c - new p
; d - where to go
;any files above the new p and below the current p are to be released
gotoc.: push p,c ;new P
push p,b ;new O
hrrz e,p ;release if leq e
hrrz f,c ;and gt f
movei g,blktab ;loop over blktab
;loop on blktab
gotol: move b,(g) ;get the fcb addr there
camle b,f ;if leq f
camle b,e ;or g e
jrst gotocn ; don't do anything with it
;here if the FCB is in area to be released
pushj p,clofxx
setzm filtst(b) ;and indicate no longer valid
setzm (g) ;clear table entry
setom blklck-blktab(g) ;and release lock on it
;end of loop on blktab
gotocn: camge g,lstblk
aoja g,gotol ;if any more to look at, do so
;now we have killed all the files that we should have. Do the goto
pop p,o ;new O
pop p,t ;new P
move p,t
jrst (d) ;go to place where we should
;dispc. - dispose of a record containing a file. Search our
;database for one that might be it
; b - addr of record
; c - length of record
dispc.: push p,b ;save b and c
push p,c
move f,b ;f - lower limit
move e,b
add e,c ;e - upper limit
movei g,blktab ;loop over blktab
;loop on blktab
dispfl: move b,(g) ;get the fcb addr there
caml b,f ;if lt f
caml b,e ;or ge e
jrst dispfn ; don't do anything with it
;here if the FCB is in area to be released
pushj p,clofxx
setzm filtst(b) ;and indicate no longer valid
setzm (g) ;clear table entry
setom blklck-blktab(g) ;and release lock on it
;end of loop on blktab
dispfn: camge g,lstblk
aoja g,dispfl ;if any more to look at, do so
pop p,c
pop p,b
popj p,
;[14] Special exit for fatal errors
endl: ;tops-20 name for this
erend: clrbfi ;[14] Unexpected event - clear typeahead
quit:
end: movei g,blktab ;loop through all files
endcl: skipn b,(g) ;get the fcb addr there
jrst endcn ;nothing there, try next
pushj p,clofxx ;close it
setzm filtst(b) ;and indicate no longer valid
setzm (g) ;clear table entry
setom blklck-blktab(g) ;and release lock on it
endcn: camge g,lstblk ;go to next, if any
aoja g,endcl
exit
ife ka10sw,<
repeat 0,<
;At the moment we don't need this code, because we do an initial CORE
;UUO to allocate all of memory
;[2] The following is an emulation of the page UUO for tops-20. It is just
;[2] like cor20, except that the pdl can be used for saving ac's and that
;[2] the argument comes from heaexp instead of corexp.
new20: push p,1 ;[2] save ac's used by jsys
push p,2 ;[2]
movei 1,400000 ;[2] this process
movei 2,1b22 ;[2] nxm interrupt
104000,,133 ;[2] dic
hrrz 2,heaexp+1 ;[2] page needed
lsh 2,11 ;[2] word on page
move 2,(2) ;[2] access it
movei 2,1b22 ;[2] nxm interrupt
104000,,131 ;[2] aic
pop p,2 ;[2] restore ac's
pop p,1 ;[2]
jrst newsuc ;[2] successful simulation
> ;repeat 0
> ;ife ka10sw
subttl character tables for lower-upper conversion
;[12] this whole page is part of edit 12
define letter,<exp .-beg> ;real letter
define lc,<exp .-beg-40> ;upper case equiv. of lower case letter
define linech(x),<xwd x,.-beg> ;end of line char
norcht:
beg==norcht
repeat 12,<letter> ;0 - 11
linech 1 ;12
letter ;13
linech 1 ;14
linech -1 ;15
repeat 14,<letter> ;16 - 31
linech 1 ;32
linech 1 ;33
repeat 166,<letter> ;everything else is a letter
lccht:
beg==lccht
repeat 12,<letter>
linech 1
letter
linech 1
linech -1
repeat 14,<letter>
linech 1
linech 1 ;33
repeat 105,<letter> ;34 - 140
repeat 32,<lc> ;141 - 172
repeat 5,<letter> ;173 - 177
;Here are the tables that don't show you end of line
define linech(x),<xwd x," "> ;end of line char
norchx:
beg==norchx
repeat 12,<letter> ;0 - 11
linech 1 ;12
letter ;13
linech 1 ;14
linech -1 ;15
repeat 14,<letter> ;16 - 31
linech 1 ;32
linech 1 ;33
repeat 166,<letter> ;everything else is a letter
lcchx:
beg==lcchx
repeat 12,<letter>
linech 1
letter
linech 1
linech -1
repeat 14,<letter>
linech 1
linech 1 ;33
repeat 105,<letter> ;34 - 140
repeat 32,<lc> ;141 - 172
repeat 5,<letter> ;173 - 177
;[12] end of edit 12
subttl mode-dependent dispatch tables
; get,put,.+1
; getx,putx,closer,breakin,break,curpos,setpos
; showln,fixln
nortxt: exp getcn,putcn,.+1
exp illfn,illfn,0,brkin,brkn,curpn,setpn
exp showln,fixln
norrec: exp getn,putn,.+1
exp getxn,putxx,0,brkin,brkn,curpn,setpn
exp noshow,notry
blkrec: exp getb,putb,.+1
exp getxn,putxx,0,brkin,brkn,curpn,setpn
exp noshow,notry
updtxt: exp getcu,putcu,.+1
exp illfn,illfn,brku,brkiu,brku,curpn,setpup
exp noshow,notry
updrec: exp getu,putu,.+1
exp getxu,putxx,brku,brkiu,brku,curpn,setpup
exp noshow,notry
notopn: exp unopn,unopn,.+1
notopx: exp unopn,unopn,0,unopn,unopn,unopn,unopn
exp unopn,unopn
ttytxt: exp tgetch,tputch,.+1
exp illfn,illfn,0,brktty,cpopj,retzer,cpopj
exp ttyshl,ttyfxl
trmtxt: exp getct,putct,.+1
exp illfn,illfn,0,brkt,cpopj,retzer,cpopj
exp tdvshl,tdvfxl
retzer: setzm 1(p)
cpopj: popj p,
unimp:
illfn: outstr [asciz /
? Illegal function for this mode on file /]
pushj p,wrtfnm
jrst erend
unopn: OUTSTR [ASCIZ /
? File /]
pushj p,wrtfnm
outstr [asciz /not open/]
jrst erend
get.:
getch: jrst @filget(reg)
putch: movem ac0,filcmp(reg)
put: jrst @filput(reg)
getx.: move ac1,filr99(reg)
jrst @filgtx(ac1)
putx: move ac1,filr99(reg)
jrst @filptx(ac1)
putxx: pushj p,curpos
move c,2(p) ;current postion
sub c,filrcs(b) ;go back to begin. of current record
seto d, ;suppress get
pushj p,setpos ;move to that position
move c,filrcs(b)
jrst put
pushj p,@filget(reg) ;GETS NEXT CHARACTER IN LINE
getln: skipg fileol(reg) ;IS EOLN = TRUE (CR DOESN'T COUNT)
jrst getln-1 ;NO - CHARAKTER'S IN LINE
jrst @filget(reg)
breakin:move ac1,filr99(reg)
jrst @filbki(ac1)
break: move ac1,filr99(reg)
jrst @filbrk(ac1)
curpos: move ac1,filr99(reg)
jrst @filcrp(ac1)
setpos: move ac1,filr99(reg)
jrst @filstp(ac1)
subttl device-independent routines for error recovery
showln: move a,filst1(b) ;get flags
tlne a,filctm ;is it controlling terminal?
jrst ttyshl ;yes, use special guy
;noshow - this is the default showln for devices where we can't
; really show the current line.
noshow: push p,t
push p,a
push p,c
outstr [asciz /[Error at character number /]
pushj p,curpos ;get current position
move t,2(p) ;returned value
pushj p,decprt ;print it
outstr [asciz /]
/]
pop p,c
pop p,a
pop p,t
popj p,
;arg in t, uses t,a,c
;prints arg in decimal on tty
decprt: setz c, ;c is num of digits
decprl: idivi t,12 ;a _ next digit
push p,a ;push on stack
aoj c,
jumpn t,decprl ;next digit if anything left
decpr: pop p,a ;a _ next digit
addi a,"0" ;turn to char
outchr a ;put it out
sojg c,decpr ;back for more if there are any
popj p,
fixln: move a,filst1(b) ;get flags
tlne a,filctm ;is it controlling terminal?
jrst ttyfxl ;yes, use special guy
;notry - use this routine for FIXLIN with devices where you don't
; implement retrying.
notry: outstr [asciz /Call to READ/]
pushj p,runer.
outstr [asciz /
[Skipping bad character]
/]
jrst @filget(b)
;tryagn - ask him to try again. If there is a debugger, offer to
; go to it.
;t - PC to print if error; A - FCB for printing; B - FCB
tryagn: push p,t
push p,a
push p,b
push p,c
tryag1:
;Now, if DDT is there, do a bit differently
skipn .jbddt ;.jbddt?
jrst trynod ;no - no option
;Here if DDT - give him an option
move b,-2(p)
movei c,[asciz /
[Try again, from the beginning of the bad number.]
[Or type D to enter the debugger.]
/]
pushj p,wrtstr
move b,-1(p) ;get back FCB
move a,filr99(b)
movei reg1,0 ;do the get
pushj p,@filbki(a) ;clear input buffer again
move a,filcmp(b) ;See if he typed a D
caie a,"D"
cain a,"d"
caia
jrst tryOK ;no a D - use what he gave us
;Here if he wants DDT - let runer. do it
move t,-3(p) ;PC passed to us in T
outstr [asciz /Call to READ /]
pushj p,runer.
jrst tryag1
;Here for no DDT cases
trynod: move b,-2(p)
movei c,[asciz /
[Try again, from the beginning of the bad number.]
/]
pushj p,wrtstr
move b,-1(p)
move a,filr99(b)
movei reg1,0 ;do the get
pushj p,@filbki(a) ;clear input buffer again
tryOK: pop p,c
pop p,b ;return it to the user
pop p,a
pop p,t
popj p,
;wrtstr - write string
;b - FCB
;c - addr of asciz string
;uses
wrtstr: push p,filcmp(b)
hrli c,440700 ;make byte pointer
wrtstl: ildb a,c ;get next char
jumpe a,wrtstx ;stop at zero, since asciz
movem a,filcmp(b)
pushj p,put
jrst wrtstl
wrtstx: pop p,filcmp(b)
popj p,
subttl byte input routines
;************ NEUE LAUFZEITUNTERSTUETZUNG
;getcn - normal read in buffered mode
getcn: SOSGE FILBTC(B) ;ANY BYTE LEFT IN BUFFER ?
pushj p,advclr ;advance, or return via eofclr
ildb a,filbtp(b) ;[12] get next byte
ldb t,[point 6,filbtp(b),11] ;[12] get byte size
caie t,7 ;[12] if not 7
jrst getnln ;loworder bit not line no.
movei t,1 ;[12] test for linenr or pagemark
tdne t,@filbtp(b) ;[12] last bit on?
jrst getcln ;yes - line number
getnln: andi a,177 ; no - be sure legal ascii
jumpe a,getcn ;ignore nulls
move a,@filcht(b) ;get eoln flag and mapped char
hlrem a,fileol(b) ;put down eoln flag
hrrzm a,filcmp(b) ;put down mapped char
came a,[xwd -1," "] ;carriage return in official mode
popj p,
geteol: pushj p,@filget(b) ;we have a CR, look for real EOL
skipe fileof(b) ;stop after errors
popj p,
skipg fileol(b) ;real EOL?
jrst geteol ;no, next char
popj p, ;yes, done
;Handle line numbers
getcln: MOVE AC1,@FILBTP(REG) ;NO - GET LINENUMBER OR PAGEMARK
TRZ AC1,1 ;BIT 35 TO ZERO
MOVEM AC1,FILLNR(REG) ;STORE IT TO FILLNR
MOVE AC0,FILBTC(REG)
SUBI AC0,5 ;TO OVERREAD LAST FOUR DIGITS AND TAB
JUMPGE AC0,GETNCP ;ALL FIVE CHARACTERS IN THIS BUFFER?
pushj p,@filadv(reg) ;get next buffer
jrst eofclr ;error - set eof and clear buffer
IBP FILBTP(REG) ;TO OVERREAD TAB OR CR
jrst getcn
GETNCP: MOVEM AC0,FILBTC(REG) ;RESTORE BYTECOUNT
AOS FILBTP(REG) ;INCREMENTS BYTEPOINTER BY 5
; 4 DIGITS AND TAB
JRST GETCN ;now go back and get real char
;advclr - advance, and call eofclr if error. This routine is needed
; when there is a sosge, to avoid the sequence
; sosge count
; pushj p,advance
; jrst error
; which would obviously activate error at the wrong time!
advclr: pushj p,@filadv(reg) ;advance
jrst .+2 ;error
popj p, ;OK
pop p,(p) ;abort the caller
jrst eofclr
;noradv - filadv routine for normal buffered I/O
; non-skip - error
; skip - OK
noradv: aos filphb(reg) ;we are now one block further
move ac0,filchn(reg) ;make the IN UUO
tlo ac0,(in)
xct ac0
jrst norok
pushj p,geter. ;error - analyze it
jrst norok ;there was data - use it
popj p,
norok: sosge filbtc(reg) ;caller expectes this decremented
jrst noradv ;nothing there - try again
aos (p) ;normal return
popj p,
;getcu - special version of GETCH for update mode. Differs from the
; above only in maintaining the read count in FILPPN.
getcu: SOSGE FILBTC(B) ;ANY BYTE LEFT IN BUFFER ?
pushj p,advclr ;advance or return via eofclr
sosge filppn(reg) ;end of existing part?
jrst sefclr ;yes - end of file
ildb a,filbtp(b) ;[12] get next byte
ldb t,[point 6,filbtp(b),11] ;[12] get byte size
caie t,7 ;[12] if not 7
jrst getnlu ;loworder bit not line no.
movei t,1 ;[12] test for linenr or pagemark
tdne t,@filbtp(b) ;[12] last bit on?
jrst getclu ;yes - line number
getnlu: andi a,177 ; no - be sure legal ascii
jumpe a,getcu ;ignore nulls
move a,@filcht(b) ;get eoln flag and mapped char
hlrem a,fileol(b) ;put down eoln flag
hrrzm a,filcmp(b) ;put down mapped char
came a,[xwd -1," "] ;carriage return in official mode
popj p,
getelu: pushj p,@filget(b) ;we have a CR, look for real EOL
skipe fileof(b) ;stop after errors
popj p,
skipg fileol(b) ;real EOL?
jrst getelu ;no, next char
popj p, ;yes, done
;Handle line numbers
getclu: MOVE AC1,@FILBTP(REG) ;NO - GET LINENUMBER OR PAGEMARK
TRZ AC1,1 ;BIT 35 TO ZERO
MOVEM AC1,FILLNR(REG) ;STORE IT TO FILLNR
MOVE AC0,FILBTC(REG)
SUBI AC0,5 ;TO OVERREAD LAST FOUR DIGITS AND TAB
JUMPGE AC0,GETNCU ;ALL FIVE CHARACTERS IN THIS BUFFER?
pushj p,@filadv(reg) ;get next buffer
jrst eofclr ;error - set eof and clear buffer
sosge filppn(reg) ;end of file?
jrst sefclr ;yes - do it
IBP FILBTP(REG) ;TO OVERREAD TAB OR CR
jrst getcu
GETNCU: MOVEM AC0,FILBTC(REG) ;RESTORE BYTECOUNT
movni ac0,5 ;subtract read count also
addb ac0,filppn(reg)
jumpl ac0,sefclr ;and if nothing there, do eof
AOS FILBTP(REG) ;INCREMENTS BYTEPOINTER BY 5
; 4 DIGITS AND TAB
JRST GETCU ;now go back and get real char
geter.: ;here after IN or OUT UUO fails. Analyze error and user's bits
;
; pushj p,geter.
; there was data
; there was no data
;
;geter. will return to
; +1 (ignore ret) if user says that error is OK
; and data was there (i.e. neither EOF nor non-blocking)
; +2 (abort return) having set EOF if EOF
; or non-blocking I/O failure
; print error msg and abort if non-enabled error
;;Be sure the phys. block count is incremented before calling
;;this, as we will decrement it for non-blocking failure and EOF.
;;You need not worry about this is you can show that non-blocking
;;failure is not possible. (EOF doesnt really matter.)
;;(e.g. dump-mode I/O, or initial buffer creation).
push p,ac0 ;we will use these ac's
push p,ac1
push p,reg1
movei reg1,740000 ;default error bits
move ac0,filst1(reg)
tlne ac0,filmta ;if magtape
tro reg1,2000 ;this is also error (end of tape)
move ac0,filchn(reg) ;make a GETSTS
tlo ac0,(getsts)
xct ac0
move ac1,ac0 ;save error status for user
and ac1,reg1 ;only error bits
trne ac0,20000 ;or EOF
tro ac1,20000
hrlz ac1,ac1 ;to LH
iorm ac1,filerr(reg) ;accumulate in error place
hrrz ac1,filerr(reg) ;get errors user enabled
and ac1,reg1 ;throw away non-error bits
tdc ac1,reg1 ;now we have non-enabled errors
trne ac0,(ac1) ;any non-enabled errors?
jrst getems ;yes (note EOF always skips)
tdzn ac0,reg1 ;end of file or non-blocking failure?
jrst getend ;yes - EOF return
; tdz ac0,740000 ;continuable error - first clear error status
hll ac0,filchn(reg) ;make setsts
tlc ac0,(setsts)
xct ac0
gterrt: pop p,reg1 ;now take normal return
pop p,ac1 ;restore ac's
pop p,ac0
popj p,
getend: sos filphb(reg) ;This is in case of non-blocking failure.
trne ac0,20000 ;but if EOF
setom filphb(reg) ;invalidate the block for SETPOS
aos -3(p) ;skip return (abort)
pop p,reg1
pop p,ac1
pop p,ac0
popj p, ;return via seteof
getems: pushj p,analys ;print error message if fatal
jrst erend
;getu - normal read in update mode
getu: movn reg2,reg1 ;compute AOBJN word - negative count
hrl ac1,reg2 ;to LH
hrr ac1,filcnt(reg) ;addr of first destination word
hrrm reg1,filrcs(reg) ;and save size
getstu: SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER?
pushj p,recadv ;advance or adjust count and set eof
sosge filppn(reg) ;beyond eof?
jrst recsef ;yes
ILDB AC0, FILBTP(REG) ;GET NEXT BYTE
MOVEM AC0, (AC1) ;DEPOSIT IT IN FILECOMPONENT
AOBJN AC1, GETSTU ;MORE BYTES IN THIS COMPONENT?
POPJ P, ;NO ,RETURN
;special version of receof that simulates end of file
recsef: hlre ac1,ac1 ;ac1 _ - number bytes left
addm ac1,filrcs(reg) ;adjust count of bytes done
jrst setsef
;recadv - call advance and return via receof if failure
recadv: pushj p,@filadv(reg) ;next block
jrst .+2 ;error
popj p,
pop p,(p) ;abort caller
;jrst receof ;fall into receof
;receof - adjust FILRCS and do eof
receof: hlre ac1,ac1 ;ac1 _ - number bytes left
addm ac1,filrcs(reg) ;adjust count of bytes done
jrst seteof ;set eof and return
getb1: setzm filrcs(reg) ;nothing transferred
jrst eofclr ;set eof and clear buffer
;getb - read in buffered mode for blocked tapes
getb: pushj p,@filadv(reg) ;force moving to new block
jrst getb1 ;clear buffer and set error
camle reg1,filbtc(reg) ;take min of actual size and request
move reg1,filbtc(reg)
;jrst regn ;fall into normal routine
;getn - normal read in buffered mode
GETN: movn reg2,reg1 ;compute AOBJN word - negative count
hrl ac1,reg2 ;to LH
hrr ac1,filcnt(reg) ;addr of first destination word
hrrm reg1,filrcs(reg) ;and save size
GETEST: SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER?
pushj p,recadv ;advance or adjust count, eof, return
ILDB AC0, FILBTP(REG) ;GET NEXT BYTE
MOVEM AC0, (AC1) ;DEPOSIT IT IN FILECOMPONENT
AOBJN AC1, GETEST ;MORE BYTES IN THIS COMPONENT?
POPJ P, ;NO ,RETURN
repeat 0,<
getdmp: skipa reg3,filin(reg) ;get in dump mode - input instruction
putdmp: move reg3,filout(reg) ;put in dump mode - output instruction
hrrm reg1,filrcs(reg) ;save current record length
subi reg1,1
hlrz ac0,filrcs(reg) ;length of phys block - bytes
idiv reg1,ac0 ;no. phys. blocks this operation
addi reg1,1 ;rounded up to nearest phys block
addm reg1,filphb(reg) ;update phys. block number
hrri reg3,reg1
move reg1,ac1 ;word 1 of pgm is transfer word
subi reg1,1 ; but must adjust addr
setz reg2, ;word 2 is 0
xct reg3 ;input or output
popj p, ;normal
pushj p,geter. ;error - abort or return to .-1
>
getxn: ;Extend existing record to longer variant
hrr ac0,filrcs(reg) ;ac0 _ length of record so far
camg reg1,ac0
popj p, ;done if new isn't larger
movn ac1,reg1 ;ac1 _ - new total length requested
add ac1,ac0 ;ac1 _ - additional bytes this req.
hrl ac1,ac1 ;make ac1 aobjn pointer
add ac0,filcnt(reg) ;starting addr of new portion
hrr ac1,ac0 ;ac1 _ aobjn pointer for transfer
jrst getest ;now join regular get
getxu: ;Extend existing record to longer variant
hrr ac0,filrcs(reg) ;ac0 _ length of record so far
camg reg1,ac0
popj p, ;done if new isn't larger
movn ac1,reg1 ;ac1 _ - new total length requested
add ac1,ac0 ;ac1 _ - additional bytes this req.
hrl ac1,ac1 ;make ac1 aobjn pointer
add ac0,filcnt(reg) ;starting addr of new portion
hrr ac1,ac0 ;ac1 _ aobjn pointer for transfer
jrst getstu ;now join regular get
subttl dump-mode I/O routines
repeat 0,<
dumpou: skipa ac1,filout(reg)
dumpin: move ac1,filin(reg)
;reg - file
;reg1 - object address
;reg2 - object size
caie reg,tty##
cain reg,ttyout##
jrst badmod
skipge (reg)
jrst badmod
skipe fileof(reg) ;test for error
jrst getef.
hrrm reg2,filrcs(reg) ;length of last record
hrri ac1,reg1 ;command list will be in reg1&2
subi reg1,1 ;iowd in reg1
move reg3,reg2 ;bytes inputted
subi reg3,1
hlrz reg4,filrcs(reg) ;bytes per physical block
idiv reg3,reg4 ;phys. blocks this operation
addi reg3,1 ;rounded up to nearest phys block
addm reg3,filphb(reg) ;adjust physical block no.
movn reg2,reg2 ;neg count
hrl reg1,reg2
setz reg2, ;terminate command list
xct ac1
popj P, ;OK
pushj p,geter. ;bad - returns to .-1 or abort
;NB: SETPOS depends upon USETIN and USETOU not using any AC above
;REG3.
usetin: caie reg,tty##
cain reg,ttyout##
popj p,
skipge (reg)
popj p, ;no op if string I/O
move reg3,reg2 ;arg to suppress get
pushj p,setin ;do the useti - common code
move reg1,reg3 ;get suppression for breakin
jrst brkin2
;NB: SETPOS depends upon USETIN and USETOU not using any AC above
;REG3.
usetou: caie reg,tty##
cain reg,ttyout##
popj p,
skipge (reg) ;if string I/O
popj p, ;noop
move ac0,filsta(reg) ;see if buffered
andi ac0,17
caige ac0,15
xct filout(reg) ;yes - force out old buffer
jrst .+2 ;OK return
pushj p,geter. ;error return
pushj p,setou ;common code
popj p,
setin: ;reg - file
;reg1 - block number
skipa ac1,[useti (reg1)]
setou: move ac1,[useto (reg1)]
move reg2,reg1
subi reg2,1 ;new phys block no.
movem reg2,filphb(reg) ;save in data area
move ac0,filchn(reg) ;get chan
ior ac1,ac0
xct ac1 ;never fails
hllzs filrcs(reg) ;clear out remnants of old records
setzm filrcp(reg) ; "
;set up filblc for blocked file in case in middle of block
skipn ac1,filbll(reg) ;logical block size
popj p, ;if not blocked, forget it
hrrz ac0,ac1
subi ac0,1
hlrz reg2,filrcs(reg) ;reg2 _ physical block size
idiv ac0,reg2
addi ac0,1
imul ac0,reg2 ;ac0 _ log block size rounded up to phys block
subi reg1,1
imul reg1,reg2 ;reg1 _ bytes from beginning of file
idiv reg1,ac0 ;reg2 _ bytes into logical block
hrrz ac0,filbll(reg) ;logical block size
sub ac0,reg2 ;ac0 _ bytes left in this log block
movem ac0,filblc(reg) ;save
popj p,
> ;end repeat 0
subttl byte output routines
;putcu is special entry for update mode to note that write has happened
putcu: sosl filbtc(reg) ;[32] space left in buffer?
jrst putcu1 ;[32] yes
pushj p,@filadv(reg) ;[32] no, get the next
jrst seteof ;[32] set eof and exit
putcu1: sos filppn(reg) ;count down read ctr., too
move ac0,filcmp(reg) ;get thing to output
idpb ac0,filbtp(reg) ;deposit character in output buffer
hllos filst1(reg) ;[31] note that write has happened
popj p, ;return
;adveof - advance or return via seteof
adveof: pushj p,@filadv(reg)
jrst .+2
popj p, ;OK
pop p,(p) ;abort caller
jrst seteof ;set eof and exit
;putcn - normal character write routine
putcn: sosge filbtc(reg) ;space left in buffer?
pushj p,adveof ;advance or set eof and exit
move ac0,filcmp(reg) ;get thing to output
idpb ac0,filbtp(reg) ;deposit character in output buffer
popj p, ;return
;nowadv - filadv routine for normal buffered I/O
; error return
; normal return
nowadv: aos filphb(reg) ;we are now one block further
move ac0,filchn(reg) ;make the IN UUO
tlo ac0,(out)
xct ac0
jrst nowok
pushj p,geter. ;error - analyze it
jrst nowok ;there was data - use it
popj p, ;no data there - error
nowok: sosge filbtc(reg) ;caller expectes this decremented
jrst nowadv ;nothing there - try again
aos (p) ;normal (skip) return
popj p,
;putb - write routine for blocked records
putb: pushj p,@filadv(reg) ;force new record
jrst putb1 ;no data trans
jrst putn ;now treat normallly
putb1: setzm filrcs(reg) ;so zero the count
jrst seteof ;and set eof
;putu is special entry for update mode to flag that a write has happened
putu: movn reg2,reg1 ;compute transfer word
hrl ac1,reg2 ;neg. count
hrr ac1,filcnt(reg) ;first source addr.
hrrm reg1,filrcs(reg) ;save length of record
PUTSTU: SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER ?
pushj p,recadv ;[30] advance or update cnt, eof, exit
sos filppn(reg) ;account for in read count, too
MOVE AC0,(AC1) ;GET NEXT WORD OF COMPONENT
IDPB AC0,FILBTP(REG) ;DEPOSIT IN OUTPUT BUFFER
hllos filst1(reg) ;[31] note that a write has happened
AOBJN AC1,PUTSTU ;MORE WORDS IN COMPONENT ?
POPJ P, ;NO
;putn - normal write routine for record I/O
PUTN: movn reg2,reg1 ;compute transfer word
hrl ac1,reg2 ;neg. count
hrr ac1,filcnt(reg) ;first source addr.
hrrm reg1,filrcs(reg) ;save length of record
PUTEST: SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER ?
pushj p,recadv ;advance or adjust cnt, eof, exit
MOVE AC0,(AC1) ;GET NEXT WORD OF COMPONENT
IDPB AC0,FILBTP(REG) ;DEPOSIT IN OUTPUT BUFFER
AOBJN AC1,PUTEST ;MORE WORDS IN COMPONENT ?
POPJ P, ;NO
subttl minor device-independent routines
PUTLN: MOVEI AC0,15 ;CR
PUSHJ P,PUTCH
MOVEI AC0,12 ;LF
PUSHJ P,PUTCH
POPJ P,
PUTPG: MOVEI AC0 ,15 ;<CR>
PUSHJ P,PUTCH
MOVEI AC0 ,14 ;<FF>
PUSHJ P,PUTCH
POPJ P,
wrtfnm: move reg1,fildev(reg) ;dev name
jumpe reg1,wrtfn1 ;nothing there to do
camn reg1,[sixbit /DSK/] ;see if DSK:
jrst wrtfn1 ;forget it
hrri reg1,fildev(reg) ;now print dev
hrli reg1,440600
movei reg2,6
ildb reg3,reg1
addi reg3,40
caie reg3,40
outchr reg3
sojg reg2,.-4
movei reg3,":" ;and trailing colon
outchr reg3
WRTFN1: HRRI REG1,FILNAM(REG) ;ADDRESS OF FILENAME
HRLI REG1,440600 ;SET UP BYTE POINTER
MOVEI REG2, 6 ;CHARACTER COUNT
ILDB REG3,REG1 ;GET NEXT CHARACTER
ADDI REG3, 40 ;CONVERT TO ASCII
caie reg3,40 ;skip blanks
OUTCHR REG3
SOJG REG2, .-4 ;MORE CHARACTERS ?
MOVEI REG3, 56 ;INSERT PERIOD
hlrz reg2,filext(reg) ;see if extension
skipe reg2 ;if not no period
OUTCHR REG3
MOVEI REG2, 3 ;TYPE EXTENSION
ILDB REG3,REG1
ADDI REG3, 40
caie reg3,40 ;skip blanks
OUTCHR REG3
SOJG REG2, .-4 ;ALL THREE BYTES TRANSFERRED ?
POPJ P, ;RETURN
jrst erend
subttl file openning routines
blkerr: outstr [asciz /
? Bad user lookup block for file /]
pushj p,wrtfnm
jrst erend
preblk: cain reg4,0 ;prepare user lookup block - is there one?
popj p, ;no - forget it
move ac0,(reg4) ;be sure the count is plausible
andi ac0,377777 ;[jmh] allow the non-superceding bit
cail ac0,4 ;too small
caile ac0,100 ;too big
jrst blkerr
move ac0,filnam+3(reg) ;ppn or ptr to path
movem ac0,1(reg4)
move ac0,filnam(reg) ;file name
movem ac0,2(reg4)
move ac0,filext(reg) ;extension
hllm ac0,3(reg4)
ldb ac0,[point 9,filpro(reg),8] ;protection
caie ac0,0 ;if zero, leave block alone
dpb ac0,[point 9,4(reg4),8]
popj P,
rename: skipn filbfp(reg) ;was the thing opened?
jrst unopn ;no
move ac1,filr99(reg) ;if there is a closer, do it
move ac1,filclo(ac1)
skipe ac1
pushj p,(ac1)
jumpe reg2,renam1 ;is there a new name?
push P,reg
push P,reg3
push P,reg4
push P,ac0 ;dummy
pushj P,parse.
pop P,ac0
pop P,reg4
pop P,reg3
pop P,reg
skipe fileof(reg) ;error in parse?
jrst badnam ;yes
renam1: lsh reg3,^d27 ;handle protection
movem reg3,filpro(reg)
movei ac0,filppn-2(reg) ;path ptr - now set up PPN
skipn filppn(reg) ;is ppn=0?
setz ac0, ;use zero
movem ac0,filnam+3(reg)
movei ac0,1 ;normalize filbad
movem ac0,filbad(reg)
movsi ac1,(%rename)
pushj p,lkent ;do the rename
jfcl
setz reg1, ;normal close
jrst doclos ;file got closed, so account for it
delf.: skipn filbfp(reg) ;[20] was the thing opened?
jrst unopn ;[20] no
hll reg2,filchn(reg) ;[20] make a rename
tlo reg2,(%rename) ;[20] make it rename
hrri reg2,reg3 ;[20] make it refer to reg3 for block
setzb reg3,reg4 ;[20] and make the block null
movei ac0,1 ;normalize filbad
movem ac0,filbad(reg)
xct reg2 ;[20] delete it
pushj p,lkerr
setz reg1, ;normal close
jrst doclos ;file is now closed, so account for it
append: pushj p,option
movei ac0,0 ;eof normally on
movem ac0,filbad(reg)
caie reg,ttyout## ;ignore for TTY
cain reg,tty##
jrst ttout
pushj p,setnam
jrst opener
hrrz ac0,filst1(reg) ;device type
jumpn ac0,rewrt2 ;if not disk - append is just rewrite
hrlzi ac0,filbfh(reg)
pushj p,reopen
jrst opener
push p,reg4
push p,[exp 5] ;make up extended block on stack
add p,[xwd 5,5]
;stack: saved reg4, exp 5, junk, junk, junk, junk, junk
movei reg4,-5(p) ;here is addr of ext. block
movsi ac1,(lookup)
pushj p,lkent
jrst updx
move reg4,-6(p) ;recover the user's block
movsi ac1,(enter)
pushj p,lkent
jrst updx
pop p,reg4 ;reg4 _ file size
sub p,[xwd 6,6]
movsi ac0,(outbuf)
pushj p,modini
;allocate the buffer so we can play below
move ac0,filchn(reg)
tlo ac0,(OUT)
xct ac0
jrst .+4
pushj p,geter.
jrst .+2 ;there was data - use it
jrst [pushj p,eofclr ;no data - set eof and exit
jrst opener]
;now go to last block
move reg3,reg4 ;reg3 _ size of file in words
idivi reg3,^D128 ;reg3 _ last block; reg4 _ no. bytes
addi reg3,1
cain reg4,0 ;if empty last block, skip this
jrst appemp
move reg6,filchn(reg) ;now set up to get old last block
or reg6,[useti (reg3)]
xct reg6 ;useti to it
hllz reg6,filchn(reg) ;now set mode 17 for input
or reg6,[setsts 17]
xct reg6
movsi reg1,-^D128 ;set up dump control word
hrr reg1,filbfh(reg) ;pointing to output buffer!
addi reg1,1
setz reg2, ;control word terminator
move ac1,filchn(reg) ;and make up IN uuo
ior ac1,[in reg1]
xct ac1 ;now do the input
jrst .+3
pushj p,geter.
jfcl
hrr reg6,filsta(reg) ;and restore initial status
xct reg6
appemp: hllz reg6,filchn(reg) ;get channel
or reg6,[useto (reg3)] ;make useto
xct reg6
move ac0,reg3
;[33] remove subi ac0,1
movem ac0,filphb(reg) ;store as cur phys block
;Now we figure out how far we are into a logical block, if any
appem1: cain reg4,0 ;any bytes into that block?
jrst appem2 ;no - forget it
hlrz ac0,filst2(reg) ;ac0 _ bytes per word
imul ac0,reg4 ;ac0 _ no. bytes in last block
movn ac0,ac0
addm ac0,filbtc(reg) ;subtract from count in buffer
addm reg4,filbtp(reg) ;and add words from byte ptr
appem2: sub p,[openoff]
popj p,
repeat 0,<
badmod: outstr [asciz %
? DUMPIN/OUT may not be used with TTY or a string%]
jrst erend
> ;repeat 0
resdev: ;NB: we skip any mode-dependent close routine
move ac1,filtst(b) ;is this a legal block?
caie ac1,314157
pushj p,initb. ;no - make it one
hrli ac1,notopn ;mark the channel as closed
hrri ac1,filr11(reg)
blt ac1,filr99(reg)
skipn filbfp(reg) ;if no device openned
jrst clofl1 ;release buffer if any
movei ac1,0 ;assume it works (eof false)
ldb ac0,[point 4,filchn(reg),12] ;channel
resdv. ac0, ;release the chan
movei ac1,1 ;failed
movem ac1,fileof(reg)
ldb ac1,[point 4,filchn(reg),12] ;get channel number
pushj p,lo.chn ;[25] mark channel (ac1) free
jrst clofl1 ;release buffer if any
;lkent - do lookup or enter. opcode in AC1
lkent: pushj p,preblk ;prepare user lookup block (if any)
cain reg4,0 ;is there?
hrri reg4,filnam(reg) ;no - use theirs
hll reg4,filchn(reg) ;channel
ior reg4,ac1 ;op code
xct reg4
jrst lkerr ;failed
aos (p) ;OK return
popj p,
;modini - mode-dependent initializations
; ac0 has inbuf or outbuf opcode
modini:
;Split according to dump or buffered mode
hrrz ac1,filsta(reg) ;see if dump mode (LH is bits)
andi ac1,17
cail ac1,15
jrst dmpini
;Here for buffered modes
; initialize dispatch table
hrli ac1,norrec ;assume record I/O
tlze reg5,400000 ;if blocked
hrli ac1,blkrec ;use blocking routines
skipl filcnt(reg) ;if really text
hrli ac1,nortxt ;use text dispatch
hrri ac1,filr11(reg) ;copy it to dispatch table
blt ac1,filr99(reg)
movei ac1,noradv ;set up buffer advance routine
skipn filbad(reg) ;if write
movei ac1,nowadv ;use other one
movem ac1,filadv(reg)
; See if there are existing buffers that can be reused
; Start with default for this device
MOVEI REG2,FILSTA(REG) ;ADDRESS OF NEW OPEN BLOCK
DEVSIZ REG2, ;SEE IF NEEDS SAME LENGTH
move reg2,[xwd 2,203] ;default if devsiz fails
; But if magtape and user specified a buffer size, use his
move ac1,filst1(reg) ;get flags
tlne reg5,377777 ;if request
tlnn ac1,filmta ;and magtape
jrst nosizr ; not - go on
hlr reg2,reg5 ;then use that size
trz reg2,400000 ;with funny bit cleared
addi reg2,2 ;and incremented by two because
;of odd way DEVSIZ counts
; And if he specified number of buffers, use that
nosizr: trne reg5,777777 ;non-zero spec?
hrl reg2,reg5 ;yes - use it
; Reg2 is now requested COUNT,,SIZE
move a,reg2
pushj p,getbuf ;try to get from free list
trne a,777777 ;if something there
hrli a,400000 ;mark as unused
movem a,filbfh(reg) ;save what we got as new buffers
jumpn a,bnumok ;if we got something, that's it
; if didn't find good ones, get new buffers
hll reg5,filchn(reg) ;get channel
ior reg5,ac0 ;make into inbuf/outbuf
xct reg5 ;create buffers
; Now we set up byte pointer in case we skip IN below (since PUTX needs it)
bnumok: move reg5,filbtp(reg) ;At least it has the byte size
tlz reg5,770077 ;Set it to point to first byte
hrr reg5,filbfh(reg) ;Nominal loc of 1st buffer
movei ac0,^D36 ;compute bytes per word
ldb ac1,[point 6,reg5,11] ;byte size
idiv ac0,ac1 ;ac0 _ bytes per word
hrlm ac0,filst2(reg) ;save in filst2 LH
hlrz ac1,(reg5) ;buffer size in words
trz ac1,400000 ;clear use bit
subi ac1,1 ;adjust to size of data only
imul ac1,ac0 ;ac1 _ bytes per buffer
hrrm ac1,filst2(reg) ;save in filst2 RH
addi reg5,1 ;adjust pointer to data area
movem reg5,filbtp(reg) ;and put it back
popj p,
;dump mode - not yet here
dmpini: outstr [asciz /
? Dump mode not implemented yet/]
jrst erend
;OPTION
;Initializations that are applicable to all openning, even funny
;ones such as TTY and TTYOUT. Two basic things are done:
; 1) make sure the FCB is legal, and init it if not. this includes
; setting FILCNT from the arg in A
; 2) translate the user's option string, if any, to internal bits
;
; Note that any defauting has to be done before translating the
; user's option string, so that our
; bits are or'ed into the correct words
;Also note that all ac's except T contain args to this thing.
;WARNING: Any code in this routine is NOT redone in case the
;open is retried because of error-recovery.
option:
;1 - make the block legal
move t,filtst(b) ;is this a legal block?
caie t,314157
pushj p,initb. ;no - make it one
; init FILCNT from arg passed by compiler
movn a,a ;filcnt wants negative count
hrl a,a ; in left,
hrri a,filcmp(b) ; with addr of buffer in RH
movem a,filcnt(b)
;2 - Now do the option string translation
came reg6,[exp -1] ;see if he defaulted mode
;problem is that zero is a valid mode, so compiler uses -1 for default
;The bits I check here are the error bits, which the user should never
;want to set for himself.
jrst opt1 ;no - use his
movei reg6,0 ;yes - probably 0
skipge filcnt(reg) ;if text file
movei reg6,14 ;not text - use binary
;see if there is a string to parse
opt1: push p,a ;get some working space
push p,b
came e,[exp -1] ;-1 or 0 LH is probably old format
tlnn e,777777
jrst optend ;old format
;there is an option string - parse it and set bits
;e - LH - count, RH - addr
hlrz a,e ;a _ count
hrrz t,e ;t _ byte ptr
setz e, ;e is now one of the AC's we are setting up
hrli t,440700
jumpe a,optend
optlop: ildb b,t ;b _ next char
caie b,"/" ;use / to separate options
jrst opterr ;error
sojle a,opterr ;count /, there had better be letter following
ildb b,t ;b _ option letter
soj a, ;count the letter
caile b,140 ;if lower case
subi b,40 ;make it upper
cail b,optmin ;if below first
caile b,optmax ;or above last
jrst opterr ;error
xct opttab-optmin(b) ;appropriate processing routine
jumpg a,optlop ;if any more char's, get next
;Now that all options are set up, set up the character table
optend: pop p,b ;exit
setcas: movei a,0 ;assume no lc map, standard EOL treatment
trne reg5,200000 ;if lc mapping on
tro a,2 ;set bit 2
trne reg5,040000 ;if we want to see EOL char
tro a,1 ;set bit 1
move t,[exp norchx,norcht,lcchx,lccht](a) ;get the right table
hrli t,a ;indexed on this ac
movem t,filcht(b)
pop p,a
popj p,
;UPCASE - this is for the user to call to change case
; B - FCB
; C - raise it?
;This is in this module instead of XIO because it uses magic that is
;likely to change, and because it references symbols internal to this
;module.
upcase: movsi t,fillcm ;clear any old setting of lower case bit
andcam t,filst1(b)
caie c,0 ;if user asks for turning it on
iorm t,filst1(b) ;then do so
move t,filst1(b) ;now get current flags
setz a, ;and build up index in A
tlne t,fillcm ;if lc mapping on
tro a,2 ;set bit 2
tlne t,filsel ;if we want to see EOL char
tro a,1 ;set bit 1
move t,[exp norchx,norcht,lcchx,lccht](a) ;get the right table
hrli t,a ;indexed on this ac
movem t,filcht(b)
popj p,
optmin="B"
opttab: pushj p,optbyt ;B - byte size
jrst opterr ;C - undef
tro reg6,742000 ;D - data trans errors
tro reg5,040000 ;E - show eoln
tro reg6,010000 ;F - data format errors
jrst opterr ;G - undef
jrst opterr ;H - undef
movei e,1 ;I - set interactive flag
repeat "O"-"J",< jrst opterr> ;J to N - undef
tro reg6,004000 ;O - open errors
repeat "U"-"P",< jrst opterr> ;P to T - undef
tro reg5,200000 ;U - lower to upper
optmax=="U"
optbyt: pushj p,optdec ;parse a decimal number
lsh b,^D9 ;shift it to the byte position
or reg5,b ;and or into open bits
popj p,
optdec: push p,c
push p,d
sojle a,opterd ;count colon, better be an extra after that
ildb b,t
caie b,":"
jrst opterr
setz c, ;accumulate number in c
optdcl: ildb b,t
cail b,"0"
caile b,"9"
jrst opterd
subi b,"0"
imuli c,^D10
add c,b
sojle a,optdcx ;count digit, if end of string, done
move d,t ;peek at next
ildb b,d
cain b,"/" ;if /, this is end
jrst optdcx
jrst optdcl ;really get char
optdcx: move b,c ;return value in b
pop p,d
pop p,c
popj p,
opterd: pop p,d
pop p,c
pop p,(p)
opterr: move b,a ;save a
outstr [asciz /
? Error in option string/]
move t,-4(p) ;-2 for saved args, -2 because called 2 deep
pushj p,runer.
jrst optend ;return from OPTION
;resetf - this is the main routine to do a Pascal Reset
resetf: pushj p,option
movei ac0,1 ;EOF setting for error is 1
movem ac0,filbad(reg)
caie reg,tty## ;see if openning TTY
cain reg,ttyout
jrst ttin ;set up specially
pushj p,setnam
jrst opener
hrrz ac0,filst1(reg) ;device type
trze reg5,100000 ;if normal open forced
jrst .+3 ;skip test
cain ac0,3 ;tty
pushj p,ttopin
hrrzi ac0,filbfh(reg) ;BUFFER HEADER ADDRESS
pushj p,reopen ;reinitialize and do open
jrst opener
movsi ac1,(lookup)
pushj p,lkent ;lookup
jrst xopner
;at this point the mode-independent stuff is done. Now we try various
; mode-dependent things
pushj p,chkmta ;this sets mta blksize if asked
movsi ac0,(inbuf)
pushj p,modini
movei ac0,illfn ;make write be illegal
movem ac0,filput(reg)
;Now we get the first item, if appropriate
sub p,[openoff]
skipe reg3 ;user parameter to prevent the get
jrst setnul ;don't if user told us no to
hlre reg1,filcnt(reg) ;make up arg to GET
movn reg1,reg1 ;will transfer whole buffer
jrst @filget(reg) ;call appropriate routine
chkmta: ;routine to handle blocksize requests for MTA (lh of REG5)
move ac0,filst1(reg)
tlnn ac0,filmta ;if not magtape
;;NB: ac0 is used again at mta1 - be sure it is not touched
popj p, ;forget it
tlnn reg5,377777 ;if no request
jrst mta1 ;see if want industry compat
;Now we do a TAPOP. to set the blocksize
add reg5,[xwd 1,0] ;tapop. and buffer use size+1
movei reg1,2006 ;arg block reg1:reg3 - set blocksize
ldb reg2,[point 5,filchn(reg),12] ;channel
push P,reg3 ;need this later
hlrz reg3,reg5 ;requested block size
trz reg3,400000 ;[22] clear bit for logical blocking
move ac1,[3,,reg1]
tapop. ac1,
jrst tapfai
pop P,reg3
;Now we do MTAPE to set industry-compat. mode, if requested
mta1:
tlnn ac0,filind ;request for indus mode?
popj p, ;no
move ac1,filchn(reg) ;get MTAPE
tlo ac1,(%mtape)
hrri ac1,101 ;code to set indust. mode
xct ac1 ;no error return
popj P,
tapfai: outstr [asciz/
? TAPOP. to set blocksize failed/]
jrst erend
;rclose - This is documented as a close followed by a release. To
; be consistent with Tops-20, it also deletes temporary files, so
; clofxx if used instead of clofil
rclose: move ac1,filtst(b) ;is this a legal block?
caie ac1,314157
pushj p,initb. ;no - make it one
pushj p,clofxx
move t,filchn(reg) ;get the appropriate close UUO
tlo t,(release) ;make it release
xct t
popj p,
;clofxx - like clofil, but if the file is "temporary" (i.e. internal),
; deletes it. uses A and C, I think.
clofxx: move a,filst1(b) ;get flags
tlnn a,filtmp ;if not temp
jrst norclo ;this is a normal close
;mode-dependent close
move a,filr99(b) ;mode-dependent closer
move a,filclo(a)
skipe a ;if there is one
pushj p,(a) ;call it
;change dispatch vector to error
hrli ac1,notopn ;and mark pascal file not open
hrri ac1,filr11(reg)
blt ac1,filr99(reg)
;now instead of a close, we want a delete, but it had better be open!
skipe filbfp(b) ;is there is channel open?
jrst rclo1 ;yes
;here if not open, do so
pushj p,fn.chn ;no - get a channel
dpb a,[point 4,filchn(b),12] ;put it in right field
move a,filchn(b) ;make up open UUO
hrri a,filsta(b)
push p,filbfh(b) ;save buffers (probably none) over open
tlo a,(open)
xct a ;OPEN
jrst [pop p,filbfh(b) ;can't get rid of temp file, normal close
jrst norclo]
pop p,filbfh(b)
hrri a,filnam(b) ;make arg for lookup
hll a,filchn(b) ;channel
tlo a,(lookup) ;op code
xct a
jrst norclo
;we now have an open file
rclo1: hll a,filchn(b) ;make a rename
tlo a,(%rename) ;make it rename
push p,d
hrri a,c ;arg block is in C,D
setzb c,d ;make it null
xct a ;delete the file
jrst [pop p,d ;can't delete it, proceed with close
jrst norclo]
pop p,d
ldb a,[point 4,filchn(b),12] ;channel number
pushj p,lo.chn ;[25] set channel (A) unused
jrst clofl1 ;get rid of buffers
;clofil - implements CLOSE
clofil: move ac1,filtst(b) ;is this a legal block?
caie ac1,314157
pushj p,initb. ;no - make it one
jrst doclos
norclo: setz reg1,
;reg1 contains bits
doclos:
;mode-dependent close
move ac1,filr99(reg) ;mode-dependent closer
move ac1,filclo(ac1)
skipe ac1 ;if there is one
pushj p,(ac1) ;call it
;change dispatch vector to error
hrli ac1,notopn ;and mark pascal file not open
hrri ac1,filr11(reg)
blt ac1,filr99(reg)
;if there is a channel to close, close it and free the channel
skipn filbfp(reg) ;SEE IF WE HAVE A CHANNEL ASSIGNED
jrst clofl1 ;NO - FORGET THIS
setzm filbfp(reg) ;NOTE THAT IT IS NOW GOING AWAY.
hll reg1,filchn(reg) ;get close (RH is bits)
tlo reg1,(close)
xct reg1
ldb ac1,[POINT 4,FILCHN(REG),12] ;GET THE CHANNEL NO.
pushj p,lo.chn ;[25] set channel (ac1) unused
;release the buffer, if any
clofl1: hrrz a,filbfh(b) ;see if there is a buffer
jumpe a,cloflx ;no, nothing more
pushj p,retbuf ;yes, return it to storage
setzm filbfh(b) ;there isn't now
cloflx: popj p,
;retbuf - address of buffer ring in A. Puts it in free list.
;a,c are garbaged, nothing else touched.
; This code must be very clever in case it is interrupted. The
; worst that can happen in that case is some buffer can be lost
; from the free list, but that is fairly unlikely.
retbuf:
;first we count the number of buffers in the ring
;and clear the use bit in each
push p,t ;t - bit to clear use bit
;a - start of ring
push p,b ;b - current place in ring
push p,c ;c - count
hrlzi t,400000 ;initialize the above
move b,a
movei c,1
retbfl: andcam t,(b) ;clear use bit
hrr b,(b) ;get next buffer in ring
came b,a ;same as first?
aoja c,retbfl ;no - count and loop
;now we make up the buffer description, count,,size, which is used
;to compare free buffers against what we need
hrlz c,c ;c _ count,,size
hlr c,(a) ; size field from buffer
addi c,2 ;incr size by 2 to get the way DEVSIZ counts
movem c,-1(a) ;put in -1 entry in first buffer
;Now we have the buffer list ready to put in free list
;Critical section
pushj p,enterc
move c,buflst ;old list
movem c,1(a) ;link old list after us
movem a,buflst ;and put us as head of list
pushj p,leavec
;End critical section
pop p,c
pop p,b
pop p,t
popj p,
;getbuf - get a buffer ring.
; A - count,,size of buffers in ring. Returns addr of first
; buffer found, or 0 if none
; All but A are saved.
getbuf: push p,b
push p,c
;begin critical section
pushj p,enterc
;a - target description
;b - predecessor of current thing being considered
;c - current buffer being considered
movei b,buflst-1 ;free list header is predecessor
getbfl: move c,1(b) ;look at next
jumpe c,getbfn ;end of list - none there
camn a,-1(c) ;compare desired with this one
jrst getbff ;match - we have found one
move b,c ;failed, advance
jrst getbfl
;we found one, b=pred, c=this
getbff: move a,1(c) ;get next
movem a,1(b) ;link it as next from pred
setzm -1(c) ;clear garbage used for list linkage
setzm 1(c)
;here also if none found, c=0 in that case
getbfn: pushj p,leavec
;end criticial section
move a,c ;return thing found
pop p,c
pop p,b
popj p,
getchn: pushj p,fn.chn ;get a channel for user to play with
movem ac1,1(p) ;place to return ftn. value
popj p,
relchn: cail reg,0 ;free a channel user is done with
caile reg,17 ;see if legal
jrst badchn ;no
move ac1,reg ;[25] now free it
pushj p,lo.chn ;[25]
popj p,
badchn: outstr [asciz /
? RELCHN: illegal channel/]
jrst erend
curchn: ldb ac0,[point 4,filchn(reg),12] ;get a file's chan
movem ac0,1(P) ;and return it
popj P,
lkerr: move ac0,(reg4) ;here if lookup fails - get code
tlnn ac0,777777 ;this is word 0 - was it extended?
addi reg4,2 ;yes - code is later is block
hrrz ac0,1(reg4) ;get error code
jrst opnerr
rewrit: pushj p,option
setz ac0, ;EOF setting for error is 0
movem ac0,filbad(reg)
caie reg,ttyout## ;see if openning TTY
cain reg,tty##
jrst ttout ;set up specially
pushj p,setnam
jrst opener
rewrt2: ;secondary entry for append
hrrz ac0,filst1(reg) ;device type
trze reg5,100000 ;if normal open forced
jrst .+3 ;skip test for tty
cain ac0,3 ;tty
pushj p,ttopou
hrlzi ac0,filbfh(reg)
pushj p,reopen
jrst opener
movsi ac1,(enter) ;do enter
pushj p,lkent
jrst opener
pushj p,chkmta ;set mta blocksize if asked
movsi ac0,(outbuf)
pushj p,modini ;now do mode-dependent init
movei ac0,illfn ;make reading illegal
movem ac0,filget(reg)
sub p,[openoff]
popj p,
nochan: setzm filbfp(reg) ;no chans-get sure we remember
movei ac0,^d103 ;and set error code
jrst opnerr
badnam: movei ac0,^d102 ;here if syntax error in file name
jrst opnerr
operr: movei ac0,^d101 ;here if the open UUO failed
jrst opnerr
opnerr: tro ac0,1B24 ;general routine for all errors in reset etc.
hrlm ac0,filerr(reg) ;lookup/enter code, with bit 23 on
move ac0,filerr(reg) ;see if we are enabled for these errors
hrli ac0,notopn ;enabled for error - mark file not open
hrri ac0,filr11(reg)
blt ac0,filr99(reg)
jrst eofclr ;set eof and clear variable
subttl REOPEN, BREAK, and BREAKIN
;Device-indepedent initializations for open routines
; save parameters in case of error
; close old file
; get file name
; get device type
;Note that this routine saves data on the stack, to allow restarting
;the routine in case of an error. This means that the caller will
;have to prune the stack before returning.
setnam: push p,reg4 ;save AC's in case of error retry
push p,reg5
push p,reg6
push p,-3(p) ;our return address
openoff==<xwd 4,4> ;use this to clean off the stack
;stack is now ret addr; reg4; reg5; reg6; ret addr
;the low ret addr is used for the error retry
push p,reg1
movei a,norclo ;assume normal close
tlnn reg1,400000 ;but if getting new name from tty
skipe reg2 ;or file spec
movei a,clofxx ;then kill any old temp file
pushj p,(a) ;close one way or the other
pop p,reg1
move ac0,reg6 ;set up enabled errors
andi ac0,776000
movem ac0,filerr(reg)
tlnn reg1,400000 ;if getting from tty, length may be 0
jumpe reg2,setnm1 ;if no name, skip the name parsing
PUSH P,REG
PUSH P,REG3
push P,reg4
push P,reg5
push p,reg6
push P,ac0 ;dummy entry- gets garbaged
pushj p,parse. ;parse file name
pop P,ac0
pop p,reg6
pop P,reg5
pop P,reg4
POP P,REG3
POP P,REG
skipe fileof(reg) ;see if parse complained
jrst badnam ;yes - bad file name
jrst setnm2 ;now we have a good name
;here if user didn't give a name. See if we have an old one
setnm1: skipe fildev(reg)
jrst setnm2 ;yes, we have a name of some sort
;here if no spec and no existing name - this is an internal file, we have
;to gensym a name. Also, we set filtmp so it gets deleted upon exit of
;the lexical scope in which it was created.
;The name we make is of the form 001234.nnn where 1234 is
;the address of the FCB in octal (for debugging), and nnn is job number
movsi t,filtmp ;set temp flag
iorm t,filst1(b)
;name
hrlz a,b ;a _ fcb addr left justified
movei c,6 ;c _ digit counter
setz t, ;t _ place where we build up name (sixbit)
maksp1: lsh t,3 ;make room for next digit
lshc t,3 ;next digit into RH of T
tro t,20 ;turn number into digit
sojg c,maksp1 ;do for all digits
movem t,filnam(b)
;extension
pjob a, ;a _ job number left just
lsh a,^D27
movei c,3 ;c _ digit counter
setz t, ;t _ place where we build up name
maksp2: lsh t,3
lshc t,3
tro t,20
sojg c,maksp2
lsh t,^D18 ;needs to be left justified
movem t,filext(b)
;rest of params
movsi t,'DSK' ;always disk
movem t,fildev(b)
setzm filpro(b)
setzm filppn-1(b)
setzm filppn(b)
setzm filppn+1(b)
setnm2: move ac0,fildev(reg) ;see if magtape
devtyp ac0,
setz ac0,
andi ac0,77 ;device code
hrrm ac0,filst1(reg) ;save it for the world
aos (p) ;ok return is skip
popj p,
;XOPNER is a special version of OPENER for RESET. It checks for
;"temporary" (i.e. internal) files, and if it is failing with
;file not found, allows the error. this is because a non-existent
;input file is supposed to give immediate EOF, not error.
xopner: move ac0,filst1(reg) ;magic bits
tlnn ac0,filtmp ;if not temp file
jrst opener ;treat as usual
hlrz ac0,filerr(reg) ;get error code
caie ac0,1B24+0 ;file not found?
jrst opener ;no - treat as usual
jrst opene1 ;yes - just give EOF return
;OPENER - error processor for the 4 file openning routines. This
;routine is called from the top level of the openning routine.
;It either aborts that routine or restarts it, depending upon the
;user's request. It uses the saved data on the stack (from SETNAM)
;to do the restart, if requested.
opener: move ac0,filerr(reg) ;RH is error bits user specified
trne ac0,1B24 ;did he allow open errors?
jrst opene1 ;yes - do a normal return
push p,reg3 ;analys kills reg3
pushj p,analys ;no - print error message
outstr [asciz /Try another file spec: /] ;and let him try again
pop p,reg3 ;restore AC's for restart
pop p,reg6
pop p,reg5
pop p,reg4
setz reg2, ;length of file spec=0
movsi reg1,400000 ;get spec from TTY
jrst setnam ;recycle to SETNAM call
;The jrst setnam works because the stack still has the return address
;used when SETNAM was originally called. So this goes to SETNAM and
;then SETNAM returns near the beginning of the main routine.
opene1: sub p,[openoff] ;remove garbage left on stack by SETNAM
popj p,
;reopen performs all initializations that are mode-independent and then
; opens the file
reopen: setzm filbtc(reg) ;zero for getindex to get correct error code
movem ac0,filbfp(reg) ;set up buffer header
pushj p,fn.chn ;get a free channel
jumpl ac1,nochan ;if -1, none
dpb ac1,[point 4,filchn(reg),12]
;set up the mode
movem reg6,filsta(reg);put mode in open block
andi reg6,776000 ;[16] and the error bits in error place
movem reg6,filerr(reg)
andcam reg6,filsta(reg);clear these bits in mode word
;set up flags, protection, etc. - all the parameters in the f.c.b.
acset3: setz reg1, ;assume no flags
hrrz ac0,filst1(reg) ;get device code
cain ac0,2 ;magtape?
tlo reg1,filmta ;if so - set bit in filptr
cain ac0,3 ;tty?
pushj p,chkctm ;if so, see if controlling term
trze reg5,400000 ;request for indust compat?
caie ac0,2 ;and magtape?
jrst .+2 ;no
tlo reg1,filind ;yes
trze reg5,200000 ;request for lower case mapping?
tlo reg1,fillcm ;yes - set it
trze reg5,040000 ;request to see end of line?
tlo reg1,filsel ;yes - set it
movsi ac0,filtmp ;use old FILTMP flag if any
and ac0,filst1(reg) ;ac0 now has old tmp flag
ior reg1,ac0 ;or it into flags we're making
hllm reg1,filst1(reg) ;now put result in flag area
setzm filrcs(reg)
setom filphb(reg)
skipn filbad(reg) ;[33] if writing
aos filphb(reg) ;[33] starts at block zero
move ac0,reg3 ;move prot code into right place
lsh ac0,^D27 ; in ac0 so we don't change reg3
movem ac0,filprot(reg) ; which is also interactive flag
MOVE AC0,[XWD 777000,0] ;ZERO REST OF PROT WORD
ANDM AC0,FILPROT(REG)
HLLZS FILEXT(REG) ;ZERO REST OF EXTENSION WORD
MOVEI AC0,FILPPN-2(REG) ;POINTER TO PATH
SKIPN FILPPN(REG) ;IS THERE ANYTHING THERE?
SETZ AC0, ;NO - USE ZERO
MOVEM AC0,FILNAM+3(REG) ;WHERE PATH POINTER GOES
move ac0,filbad(reg) ;set eof to normal value
trc ac0,1
movem ac0,fileof(reg)
SETZM FILEOL(REG) ;CLEAR EOL - MARKER
SETZM FILCMP(REG) ;CLEARS COMPONENT
MOVE AC0,[ASCII/-----/] ;FOR INITIALIZE FILLINENUMBER
MOVEM AC0,FILLNR(REG)
;actually do the open
move ac0,filchn(reg) ;make up open UUO
hrri ac0,filsta(reg)
tlo ac0,(open)
xct ac0 ;OPEN
jrst operr ;error on open
trnn reg5,077000 ;byte size spec?
jrst openx ;no - done
ldb ac0,[point 6,reg5,26] ;yes - put it in
dpb ac0,[point 6,filbtp(reg),11]
trz reg5,077000 ;and clear field for buffer count
openx: aos (p) ;normal exit - skip
popj p,
chkctm: push p,t
push p,a
move t,fildev(b)
devnam t,
setz t,
getlin a,
camn a,t
tlo reg1,filctm
pop p,a
pop p,t
popj p,
spcsiz=^D30 ;words
;parse. - file name parser. just calls PARSE unless bit set asking to
; get file spec from TTY.
parse.: movsi a,filtmp ;this is now a real file
andcam a,filst1(b)
tlnn c,400000 ;if no special request
jrst parse ;just call parse directly
push p,o ;standard entry sequence
hrls o,p
hrri p,spcsiz*5+1(p)
caig n,40(p)
jsp a,corerr
spclp1: move a,[point 7,1(o)] ;put file spec on stack
movei d,0 ;count in d
spclop: inchwl t ;get char
caie t,33 ;stop at eol
cain t,14
jrst spcdon
cain t,12
jrst spcdon
cain t,15
jrst spccr ;special for cr
idpb t,a ;normal char - put it in
aoj d, ;count
caige d,spcsiz*5 ;if too many, error
jrst spclop ;else go back for more
outstr [asciz /
? File spec too long. Try again: /]
clrbfi
jrst spclp1 ;try again
spccr: inchwl t ;read lf
spcdon: movei c,1(o) ;addr is on stack
push p,b
push p,t
pushj p,parse ;parse the thing
pop p,t
pop p,b
skipn fileof(b) ;was it ok?
jrst spcxit ;yes - done
outstr [asciz /
? Illegal file spec. Try again: /] ;no - try again
clrbfi
jrst spclp1
spcxit: hrri p,(o) ;normal exit code
pop p,o
popj p,
;EOF handling. There are 4 routines:
;
; SETEOF - just sets Pascal EOF
; EOFCLR - sets Pascal EOF and also clears the Pascal buffer
;
;Versions of the above using SEF instead of EOF. These are used by the
; pmap I/O routines to simulate EOF. When doing pmap I/O, we never
; really get a physical EOF. Instead we simulate it when we reach a
; position that matches the end of file pointer.
setsef: hrlzi ac0,20000 ;eof bit
iorm ac0,filerr(reg) ;say it happened
;jrst seteof
seteof: move ac0,filbad(reg) ;set eof to complement of normal
movem ac0,fileof(reg)
popj p,
sefclr: hrlzi ac0,20000 ;eof bit
iorm ac0,filerr(reg) ;say it happened
;jrst eofclr
eofclr: move ac0,filbad(reg) ;set eof to complement of normal
movem ac0,fileof(reg)
skipge filcnt(reg) ;see if ASCII
jrst seteob ;no - clear binary element
MOVEI AC0, " "
MOVEM AC0,FILCMP(REG) ;INSERT BLANK
movei ac0,1 ;be sure it is 1
movem ac0,fileol(reg) ;now called in wierd contexts
POPJ P,
seteob: push p,ac1 ;can't use 0 as index!
move ac1,filcnt(reg)
setzm (ac1) ;clear binary component
aobjn ac1,.-1
pop p,ac1
popj p,
;put null in buffer and set eof - for interactive file openning
setnul: movei ac0,1
movem ac0,fileol(reg)
setzm filcmp(reg)
popj p,
brkn: setzm filrcs(reg) ;forget last record
pushj p,@filadv(reg) ;put out this buffer
jrst seteof ;set eof and exit
popj p,
brkin: setzm filrcs(reg) ;forget last record
move ac0,filchn(reg) ;make a WAIT
tdo ac0,[exp %wait]
xct ac0 ;never skips
movsi ac0,400000 ;clear out buffer
move ac1,filbfh(reg) ;first in ring
andcam ac0,(ac1) ;clear use bit
hrr ac1,(ac1) ;get next buffer
came ac1,filbfh(reg) ;full circle?
jrst .-3 ;no - clear next
move ac0,filchn(reg) ;make in IN UUO
tlo ac0,(IN)
hrr ac0,filbfh(reg) ;in with explicit buffer addr
aos filphb(reg) ;note that another block has come
xct ac0
jrst brkdn. ;normal
pushj p,geter. ;error - return to .-1 or abort
jrst brkdn. ;there is data
jrst eofclr ;there is not - set eof and exit
;entry for a routine that needs to do implicit GET
brkdn.: skipe reg1 ;user asked us not to do get?
jrst setnul ;[34] yes - done
hlre reg1,filcnt(reg) ;set up arg to GET
movn reg1,reg1 ;transfer whole buffer
jrst @filget(reg) ;do the GET
brktty: clrbfi ;this has same effect as above
movei ac0,tgetch ;cancel saved LF if any
movem ac0,filget(reg)
jrst brkdn.
TTYOPN: PUSHJ P,PUTLN
MOVEI AC0,"*" ;TYPE ASTERISK
PUSHJ P,PUTCH
PUSHJ P,BREAK
POPJ P,
subttl random access for normal files
;curpn - curpos for normal buffered files
curpn: move ac0,filbad(reg) ;see if eof
camn ac0,fileof(reg)
jrst cureof ;yes - return -1
skipge filphb(reg) ;see if at start of file
jrst retzer ;yes - return 0
curpn1: hrrz ac0,filst2(reg) ;ac0 _ buffer size in bytes
imul ac0,filphb(reg) ;ac0 _ bytes before this buffer
push p,ac0 ;0(p) _ bytes before this buffer
move ac1,filbfh(reg) ;ac1 _ addr of buffer
move ac1,1(ac1) ;ac1 _ words in this buffer
hlrz ac0,filst2(reg) ;ac0 _ bytes per word
imul ac1,ac0 ;ac1 _ bytes this buffer
sub ac1,filbtc(reg) ;ac1 _ bytes in buf. before cur. pos
add ac1,0(p) ;ac1 _ bytes in file before cur. pos
pop p,ac0 ;restore stack
movem ac1,1(p) ;return cur. pos
popj p,
cureof: setom 1(p) ;return eof indication
popj p,
;setpn - setpos for normal buffered files
; reg1 - target
; reg2 - suppress get
setpn: skipn filbad(reg) ;must be input file
jrst illfn
setzm fileof(reg) ;[27] clear end of file
; skipe fileof(reg) ;no-op at end of file
; popj p,
hrrz reg4,filst2(reg) ;reg4 _ bytes/block
move reg3,reg1 ;reg3 _ target in bytes
idiv reg3,reg4 ;reg3 _ block#; reg4 _ bytes into block
camn reg3,filphb(reg) ;on right block already?
jrst setpn3 ;yes - skip read
;here if we have to move to a new block
movem reg3,filphb(reg) ;[27] for breakin
sos filphb(reg) ;[27] filphb _ block before this one
addi reg3,1 ;adjust reg3 to monitors numbering scheme
tlo reg3,(useti) ;make useti
ior reg3,filchn(reg)
xct reg3 ;useti to correct block
seto reg1, ;suppress get from breakin
pushj p,brkin ;now let breakin get in the block
skipe fileof(reg) ;did it work?
popj p, ;no
;here to get to the right byte within the block after reading it
setpn1: movn reg3,reg4 ;reg3 _ - bytes into the block
addm reg3,filbtc(reg) ;adjust byte counter
move reg3,reg4 ;reg3 _ bytes into the block
hlrz reg4,filst2(reg) ;reg4 _ bytes per word
idiv reg3,reg4 ;reg3 _ words, reg4 _ bytes
addm reg3,filbtp(reg) ;adjust byte pointer by words
jumpe reg4,setpn2 ;and if non-zero bytes
ibp filbtp(reg) ;then by bytes
sojg reg4,.-1
;here to get new item unless suppressed
setpn2: skipe reg2 ;suppress get?
popj p, ;yes - done
hlre reg1,filcnt(reg) ;no - do get
movn reg1,reg1
jrst @filget(reg)
;here if current buffer is right - redo count and pointer
setpn3: move ac1,filbfh(reg) ;ac1 _ words in this buffer
move ac1,1(ac1)
hlrz ac0,filst2(reg) ;ac0 _ bytes per word
imul ac1,ac0 ;ac1 _ bytes in this buffer
movem ac1,filbtc(reg) ;use for byte count
move ac1,filbtp(reg) ;ac1 _ byte size field only
tlz ac1,770077
hrr ac1,filbfh(reg) ;addr of buffer
addi ac1,1 ;start at data area
movem ac1,filbtp(reg) ;use for byte pointer
jrst setpn1 ;now adjust for count into buffer
subttl update mode
;Update mode is done in mode 17 (dump). However it is originally
; openned normally and buffers are allocated. We just do I/O into
; them in dump mode. Note that only one of the buffers is used.
; In additional to the usual information, the length of the file
; in words is kept at -1 in the buffer header. This is because we
; have to simulate end of file ourselves in order to get things
; accurate to the word, instead of just the block as the easiest
; implementation would do. Also, RH(filst1) is a flag indicating
; whether the current buffer has been written into, so we don't
; rewrite it unless we have to. This is set up so that sequential
; reading in update mode doesn't have any extra overhead (except
; that there is a block size of 1)
update: pushj p,option
caie reg,tty## ;illegal except for disk
cain reg,ttyout##
jrst upbdev
movei ac0,1 ;set up for input
movem ac0,filbad(reg)
pushj p,setnam
jrst opener
hrrz ac0,filst1(reg)
jumpn ac0,upbdev
hrrzi ac0,filbfh(reg) ;open file and init status
pushj p,reopen
jrst opener
push p,reg4
push p,[exp 5] ;make up extended block on stack
add p,[xwd 5,5]
;stack: saved reg4, exp 5, junk, junk, junk, junk, junk
movei reg4,-5(p) ;here is addr of ext. block
movsi ac1,(lookup)
pushj p,lkent
jrst updx
move reg4,-6(p) ;recover the user's block
movsi ac1,(enter)
pushj p,lkent
jrst updx
pop p,reg4 ;reg4 _ file size
sub p,[xwd 6,6]
movsi ac0,(inbuf) ;allocate buffers and other init's
pushj p,modini
move ac1,filbfh(reg) ;ac1 _ addr of buffer
move ac0,reg4 ;ac0 _ size of file in words
movem ac0,-1(ac1) ;save in buffer header
movei ac0,200 ;always treat buffer as full
movem ac0,1(ac1) ; (this is word count in header)
move ac0,filchn(reg) ;go into dump mode
tlc ac0,(setsts) ;make a setsts
hrr ac0,filsta(reg) ;original file status
tro ac0,17 ;same except dump mode
hrrm ac0,filsta(reg) ;save it for future setsts's
xct ac0 ;do the setsts
hrli ac0,updtxt ;now set up special dispatch table
skipge filcnt(reg) ;if record
hrli ac0,updrec ;use that one
hrri ac0,filr11(reg)
blt filr99(reg)
movei ac0,updadv ;special advance routine
movem ac0,filadv(reg)
setzm filppn(reg) ;special count for read
sub p,[openoff]
jrst setnul ;interactive open
updx: sub p,[xwd 7,7]
jrst opener
;breakin
brkiu: setzm filcnt(reg)
jrst brkdn.
;break
brku: setzm filrcs(reg) ;forget last record
push p,fileof(reg) ;save old eof
setzm fileof(reg) ;clear eof to make op always happen
pushj p,updadv ;next buffer
pushj p,seteof ;if error, set eof
pop p,ac0 ;get old eof
iorm ac0,fileof(reg) ;reset it if it was on
popj p,
;special buffer advance
; error
; OK
updadv: push p,ac1
push p,reg1
push p,reg2
move reg1,filphb(reg) ;current block
addi reg1,1 ;next block
hrrz reg2,filst2(reg) ;bytes per block
imul reg1,reg2 ;reg1 _ first byte next block
seto reg2, ;suppress get
pushj p,setpup ;not go there random access
sos filbtc(reg) ;caller expects it to be decremented
pop p,reg2
pop p,reg1
pop p,ac1
skipn fileof(reg) ;if no failure
aos(p) ;success return
popj p,
;setpup - setpos for update mode
; reg1 - target
; reg2 - suppress get flag
setpup: setzm fileof(reg) ;[27] clear eof
; skipe fileof(reg) ;forget it if eof
; popj p,
;ac1 is addr of buffer throughout this routine
move ac1,filbfh(reg) ;ac1 _ addr of buffer
push p,reg3
push p,reg4
push p,reg5
move ac0,filst1(reg) ;see if write needed
trne ac0,-1 ;if no write or
skipge reg3,filphb(reg) ;if still at start of file
jrst setpu2 ;then no write needed
;reg3 _ current block
;here if the current block has changed. may have to write it
ldb ac0,[point 29,-1(ac1),28] ;ac0 _ block # of end of file
camge reg3,ac0 ;if at last block or later
jrst setpu1 ;not
;here if we are at last block of the file or later - update eof
lsh reg3,7 ;reg3 _ words before this block
hrrz ac0,filbtp(reg) ;ac0 _ words this block
subi ac0,1(ac1)
add ac0,reg3 ;ac0 _ new words in file
camle ac0,-1(ac1) ;word cnt, ac0 _ max (old,new)
movem ac0,-1(ac1)
move ac0,-1(ac1)
sub ac0,reg3 ;ac0 _ words this block
caile ac0,200 ;if more than 200, just use 200
setpu1: movei ac0,200
;at this point, the eof count is updated, and ac0 has # words in this buf.
;we now find out whether we have to write the block
move reg4,reg1 ;reg4 _ target byte
hrrz reg5,filst2(reg) ;reg5 _ bytes/block
idiv reg4,reg5 ;reg4 _ target block
camn reg4,filphb(reg) ;same as now?
jrst setpu4 ;yes - no I/O needed
;here when we have to write the block and read new one
movn reg3,ac0 ;reg3 will be IOWD
hrl reg3,reg3
hrri reg3,1(ac1)
setz reg4, ;reg4 will be command end
move ac0,filphb(reg) ;ac0 will be USETO to current block
add ac0,[useto 1]
ior ac0,filchn(reg)
xct ac0 ;do useto
move ac0,filchn(reg) ;ac0 will be OUT uuo
ior ac0,[out reg3]
xct ac0 ;do OUT
jrst setpu3 ;OK
pushj p,geter.
jrst setpu3
jrst setpuy
;here when the block has not changed. See if we need new one.
setpu2: move reg4,reg1 ;reg4 _ target byte
hrrz reg5,filst2(reg) ;reg5 _ bytes/block
idiv reg4,reg5 ;reg4 _ target block
camn reg4,filphb(reg) ;same as now?
jrst setpu4 ;yes - no I/O needed
;here to read a new block
setpu3: hllzs filst1(reg) ;clear change indicator of old block
move reg3,reg1 ;reg3 _ target byte
hrrz reg4,filst2(reg) ;reg4 _ bytes/block
idiv reg3,reg4 ;reg3 _ target block; reg4 _ bytes into it
move reg4,filphb(reg) ;reg4 _ old block
movem reg3,filphb(reg) ;say we are there
move ac0,-1(ac1) ;ac0 _ last block in file
subi ac0,1
ash ac0,-7
camle reg3,ac0 ;is the desired block there?
jrst setp3b ;no - don't try to read it
addi reg4,1 ;see if next block
camn reg4,reg3 ;is what we want
jrst setp3a ;yes - no need for useti
add reg3,[useti 1] ;make useti for block
ior reg3,filchn(reg)
xct reg3 ;do useti
setp3a: hrli reg3,-200 ;make IOWD
hrri reg3,1(ac1)
setz reg4,
move ac0,filchn(reg) ;make IN
ior ac0,[in reg3]
xct ac0 ;do IN
jrst setpu4 ;OK
pushj p,geter.
jrst setpu4
jrst setpux
;here when asked to read a non-existent block
setp3b: setzm 2(ac1) ;zero first word
hrli ac0,2(ac1) ;now rest of block
hrri ac0,3(ac1)
blt ac0,201(ac1)
;all paths join here - we are at the right block
setpu4: move reg3,reg1 ;reg3 _ target
hrrz reg4,filst2(reg) ;reg4 _ bytes / block
idiv reg3,reg4 ;reg4 _ bytes into block
;reinit buffer
move ac0,filbtp(reg) ;reinit buffer
tlz ac0,770077
hrri ac0,1(ac1)
movem ac0,filbtp(reg) ;new pointer
hlrz ac0,filst2(reg)
lsh ac0,7
movem ac0,filbtc(reg) ;new count (full 200 words)
movem ac0,filppn(reg) ;special count for read
;set special count for read if at end
ldb ac0,[point 29,-1(ac1),28] ;ac0 _ block # of eof
camge reg3,ac0 ;might the block be only part full?
jrst setpu5 ;no - go adjust count and pointer
move ac0,reg3 ;ac0 _ block number
lsh ac0,7 ;ac0 _ words before this block
move ac1,-1(ac1) ;ac1 _ end of file in words
sub ac1,ac0 ;ac1 _ end of file relative to start of buf
caige ac1,0 ;if less than 0, normal to zero
movei ac1,0
caile ac1,200 ;if greater than 200, normal to 200
movei ac1,200
hlrz ac0,filst2(reg) ;ac0 _ bytes per word
imul ac0,ac1 ;ac0 _ count in bytes
movem ac0,filppn(reg) ;use as special read count
setpu5: movn reg3,reg4 ;reg3 _ - bytes into the block
addm reg3,filbtc(reg) ;adjust byte counter
addm reg3,filppn(reg) ;and one for read
move reg3,reg4 ;reg3 _ bytes into the block
hlrz reg4,filst2(reg) ;reg4 _ bytes per word
idiv reg3,reg4 ;reg3 _ words, reg4 _ bytes
addm reg3,filbtp(reg) ;adjust byte pointer by words
jumpe reg4,setpux ;and if non-zero bytes
ibp filbtp(reg) ;then by bytes
sojg reg4,.-1
setpux: pop p,reg5
pop p,reg4
pop p,reg3
skipe reg2 ;get to be done?
popj p, ;no - done
hlre reg1,filcnt(reg) ;yes, do it
movn reg1,reg1
jrst @filget(reg)
setpuy: pushj p,eofclr ;error - set eof and exit
jrst setpux
upbdev: outstr [asciz /
? /]
pushj p,wrtfnm
outstr [asciz / UPDATE may only be used with disks
/]
jrst erend
subttl error analysis routines
;runer. - general-purpose routine for processing runtime errors.
; if t matters to a continuation, we assume it has been saved at erracs
; t - addr of PC to print out
; pushj p,runer.
; here if user continues (after correcting error, one hopes)
;This routine prints a PC, then either goes to a debugger (if there
;is any) or warns the user that continuation is at his own risk.
;If there is any reason to believe that P is blown, you had better
;supply a good one before calling this guy.
reloc 0
ddtgo: block 1
erracs: block 20
reloc
runer.: movem 0,erracs ;save the AC's
move 0,[xwd 1,erracs+1]
blt 0,erracs+17
move 0,erracs
OUTSTR [ASCIZ/ at user PC /]
HRRZI REG2, 6
MOVE REG3,[POINT 3,AC0,17]
ILDB AC1, REG3
ADDI AC1, 60
OUTCHR AC1
SOJG REG2,.-3
HRR AC1,.JBDDT ;LOAD PASDDT-ADDR
JUMPE AC1,hlterr ;no debugger, just halt him
move ac1,.jbddt ;want left half, too
tlze ac1,777777 ;if zero, it is PASDDT
jrst decddt ;if not, real DDT
pushj p,-1(AC1) ;GOTO 'ERRDB.'
jrst errest ;continue if he continues
decddt: movem ac0,.jbopc## ;save PC so he can continue
hrrzm ac1,ddtgo
outstr [asciz /
[Type POPJ 17,$X to continue if possible, but don't trust any results]
/]
move 0,[xwd erracs+1,1] ;restore ac's to pgm context
blt 0,16
move 0,erracs
pushj p,@ddtgo ;[3] avoid -1 entry point!
jrst errest ;continue if he exits
;no debugger, just halt and let him go on if he dares
hlterr: outstr [asciz /
[Type CONTINUE to proceed if possible, but don't trust any results]
/]
exit 1, ;continuable halt
; jrst errest
;here to continue if the user really wants to
errest: move 0,[xwd erracs+1,1]
blt 0,17
move 0,erracs
popj p,
ilfil.: outstr [asciz /
? Uninitialized file/]
move t,(p)
pushj p,runer.
movei b,tty## ;use tty instead
popj p,
blktbe: push p,t
setz t, ;we don't know the location
outstr [asciz /
? Too many files open at once/]
pushj p,runer.
pop p,t
popj p,
INXERR: OUTSTR [ASCIZ /
? array index out of bounds/]
PUSHJ P ,runer.
jrst @0
PTRER.: OUTSTR [ASCIZ /
? uninitialzed or NIL pointer/]
PUSHJ P,runer.
JRST @0
SRERR: OUTSTR[ASCIZ/
? scalar out of range/]
PUSHJ P,runer.
JRST @0
analys: hlrz ac1,filerr(reg) ;get error bits
jumpe ac1,analx ;if none, no-op
trnn ac1,1B24 ;open error?
jrst anioer ;no - analyze bits
andi ac1,177 ;yes - get code
caile ac1,30 ;codes between 31 and ^d99 are unknown
cail ac1,^d101
jrst .+2
movei ac1,36 ;unknown error
cain ac1,^d101 ;special codes get mapped down
movei ac1,33
cain ac1,^d102
movei ac1,34
cain ac1,^d103
movei ac1,35
cail ac1,0 ;otherwise we don't know it
caile ac1,36
movei ac1,36 ;unknown error code
outstr [asciz /
? /]
pushj P,wrtfnm
outstr [asciz / /]
outstr @msg(ac1)
outstr [asciz /
/]
analx: popj P,
msg:
[asciz /(0) file not found/]
[asciz /(1) no such UFD/]
[asciz /(2) protection failure/]
[asciz /(3) file being modified/]
[asciz /(4) already existing file name/]
[asciz /(5) illegal sequence of UUOs/]
[asciz /(6) UFD or RIB error/]
[asciz /(7) not a save file/]
[asciz /(10) not enough core/]
[asciz /(11) device not available/]
[asciz /(12) no such device/]
[asciz /(13) illegal UUO/]
[asciz /(14) no room/]
[asciz /(15) write-locked/]
[asciz /(16) not enought monitor table space/]
[asciz /(17) partial allocation only/]
[asciz /(20) block not free/]
[asciz /(21) can't supercede a directory/]
[asciz /(22) can't delete non-empty directory/]
[asciz /(23) SFD not found/]
[asciz /(24) search list empty/]
[asciz /(25) SFD nest level too deep/]
[asciz /(26) no-create for all structures/]
[asciz /(27) high segment not on swap space/]
[asciz /(30) can't update file/]
[asciz /(31)/]
[asciz /file connected to a string/]
[asciz /OPEN failed/]
[asciz /illegal file spec/]
[asciz /no channel free/]
[asciz /unknown error code/]
anioer: outstr [asciz /
? /]
trne ac1,1b18
outstr [asciz /Improper mode/]
trne ac1,1b19
outstr [asciz /Hard device error/]
trne ac1,1b20
outstr [asciz /Hard data error/]
trne ac1,1b21
outstr [asciz /Quota exceeded or block too large/]
trne ac1,1b23
outstr [asciz /Data format error/]
trne ac1,1B25
outstr [asciz /Physical end of tape/]
outstr [asciz / for file /]
pushj p,wrtfnm
outstr [asciz /
/]
popj p,
subttl routines to simulate I/O using TTCALL's
tgetch: inchwl ac1 ;[12] get char
tgetc3: andi ac1,177 ;[12] in case of pim-ignore parity
jumpe ac1,tgetch ;[12] skip nulls!
move a,@filcht(b) ;get eoln flag and mapped char
hlrem a,fileol(b) ;put down eoln flag
hrrzm a,filcmp(b) ;put down mapped char
camn a,[xwd -1,15] ;cr if user wants to see it
jrst tgetc1 ;must be handled oddly
came a,[xwd -1," "] ;carriage return in official mode
popj p,
jrst geteol ;is handled as for other devices
TGETC1: inchwl ac1 ;get the LF
movem ac1,filst2(reg) ;save it
movei ac0,tgetc2 ;now set up so next get gets saved char
movem ac0,filget(reg)
POPJ P,
tgetc2: move ac1,filst2(reg) ;get saved char
movei ac0,tgetch ;restore normal read routine
movem ac0,filget(reg)
jrst tgetc3 ;join normal routine
tputch: move ac0,filcmp(reg) ;get thing to output
outchr ac0 ;put it out
popj P,
ttin: setzm filbfp(reg) ;tell the world these are not open
hrli ac0,ttytxt ;init dispatch
hrri ac0,filr11(reg)
blt ac0,filr99(reg)
setzm fileof(reg) ;initialize state variables
movei ac0,1
setzm filcmp(reg) ;start with end of file and null buffer
movem ac0,fileol(reg)
andi reg6,776000 ;error bits only
movem reg6,filerr(reg) ;for data error enabling
movei ac0,0
trne reg5,200000 ;lower case to upper mapping?
tlo ac0,fillcm ;yes - set it
movem ac0,filst1(reg)
popj p,
ttout: setzm filbfp(reg)
hrli ac0,ttytxt
hrri ac0,filr11(reg)
blt ac0,filr99(reg)
movei ac0,1
movem fileof(reg)
setzm fileol(reg)
andi reg6,776000 ;error bits only
movem reg6,filerr(reg) ;for data error enabling
popj p,
;TTYSHL - Show the error char and the rest of the line
; current position. No sideeffects.
;Note that this routine is intended to be called for I/O using the
;user's terminal, but possibly when it is open as a normal device.
;GETCH is used for input, so as to synchronize with pascal I/O.
;direct outchr is used for output, since we can't assume in general
;that he has the output side open.
ttyshl: outstr [asciz /[Error was detected here:]
/]
ttysh1: skipe fileol(b) ;copy the rest of the line
jrst ttysh2
outchr filcmp(b)
pushj p,getch
jrst ttysh1
outstr [asciz /
/]
ttysh2: popj p,
;TTYFXL - clear rest of line and ask user for more.
;expects b to be set up
;t - PC to print if error msg
ttyfxl: movei a,ttyout## ;FCB for printing
jrst tryagn
subttl routines for using TRMOP. on terminals
getct: push p,[exp .toinc] ;inchwl
push p,filbtp(reg) ;iondx
push p,ac1 ;dummy
getct1: movei ac1,-2(p)
hrli ac1,2
trmop. ac1, ;get a char
jrst trmer
getct2: andi ac1,177 ;[12] in case of pim-ignore parity
jumpe ac1,getct1 ;[12] skip nulls!
cain ac1,32 ;control-Z?
jrst getct5
move ac1,@filcht(reg) ;map lower case and eoln
hlrem ac1,fileol(reg) ;[12] put down eoln flag
hrrzm ac1,filcmp(reg) ;[12] put down mapped char
camn ac1,[xwd -1,15] ;CR if user wants to see it
jrst getct3 ;is handled oddly
sub p,[xwd 3,3]
came ac1,[xwd -1," "] ;CR in official mode
popj P,
jrst geteol ;is handled as for other devices
GETCT3: movei ac1,-2(p)
hrli ac1,2
trmop. ac1, ;get the LF
jrst trmer
movem ac1,filst2(reg) ;save it
movei ac0,getct4 ;now set up so next get gets saved char
movem ac0,filget(reg)
sub p,[xwd 3,3]
POPJ P,
getct4: move ac1,filst2(reg) ;get saved char
movei ac0,getct ;restore normal read routine
movem ac0,filget(reg)
push p,[exp .toinc]
push p,filbtp(reg)
push p,ac0 ;dummy
jrst getct2 ;join normal routine
getct5: sub p,[xwd 3,3] ;here to set eof
jrst sefclr ;simulate eof, set eof, and clear buf
trmer: sub p,[xwd 3,3]
hrlzi ac0,1B18 ;consider this as improper mode error
iorm ac0,filerr(reg) ;say it happened
hrrzi ac0,1B18 ;see if it is OK
tdnn ac0,filerr(reg)
jrst getems ;no - fatal
jrst eofclr ;yes - set EOF
putct: push p,[exp .toouc] ;outchr
push p,filbtp(reg) ;iondx
push p,filcmp(reg) ;the thing to output
movei ac0,-2(p)
hrli ac0,3
trmop. ac0,
jrst trmer
sub p,[xwd 3,3]
popj P,
ttopin: move ac0,fildev(reg) ;get iondx
iondx. ac0,
popj p, ;failed - old monitor or tops-20
;use normal open
movem ac0,filbtp(reg) ;save iondx
hrli ac0,trmtxt ;init dispatch
hrri ac0,filr11(reg)
blt ac0,filr99(reg)
setzm fileof(reg) ;initialize state variables
movei ac0,1
setzm filcmp(reg) ;start with end of file and null buffer
movem ac0,fileol(reg)
movem reg6,filerr(reg) ;for data error enabling
movei ac0,0
trne reg5,200000 ;lower case to upper mapping?
tlo ac0,fillcm ;yes - set it
movem ac0,filst1(reg)
sub p,[openoff]
pop p,(p) ;we were pushj'ed to - abort caller
popj p,
ttopou: move ac0,fildev(reg) ;get iondx
iondx. ac0,
popj p, ;failed - old monitor or Tops-20
;use normal open
movem ac0,filbtp(reg) ;save iondx
hrli ac0,trmtxt
hrri ac0,filr11(reg)
blt ac0,filr99(reg)
movei ac0,1
movem fileof(reg)
setzm fileol(reg)
movem reg6,filerr(reg) ;for data error enabling
sub p,[openoff]
pop p,(p)
popj p,
brkt: push p,[exp .tocib] ;clear the buffer
push p,filbtp(reg) ;the udx
push p,ac0 ;dummy
movei ac0,-2(p)
hrli ac0,2
trmop. ac0,
jrst trmer
movei ac0,getct ;kill saved LF if any
movem ac0,filget(reg)
sub p,[xwd 3,3]
jrst brkdn.
;TDVSHL - Show the error char and the rest of the line
; current position. No sideeffects.
;Note that this routine is intended to be called for I/O using the
;user's terminal, but possibly when it is open as a normal device.
;GETCH is used for input, so as to synchronize with pascal I/O.
;direct trmop. is used for output, since we can't assume in general
;that he has the output side open.
tdvshl:
;outstr [error was detected here:]
push p,[exp .toous] ;outstr
push p,filbtp(reg) ;iondx
push p,[[asciz /[Error was detected here:]
/]] ;the thing to output
movei ac0,-2(p)
hrli ac0,3
trmop. ac0,
jrst trmer
sub p,[xwd 3,3]
;now put out the rest of the line
tdvsh1: skipe fileol(b) ;copy the rest of the line
jrst tdvsh2
;put
push p,[exp .toouc] ;outchr
push p,filbtp(reg) ;iondx
push p,filcmp(b) ;the thing to output
movei ac0,-2(p)
hrli ac0,3
trmop. ac0,
jrst trmer
sub p,[xwd 3,3]
;get
pushj p,getch
jrst tdvsh1
;outstr crlf
tdvsh2: push p,[exp .toous] ;outstr
push p,filbtp(reg) ;iondx
push p,[[asciz /
/]] ;the thing to output
movei ac0,-2(p)
hrli ac0,3
trmop. ac0,
jrst trmer
sub p,[xwd 3,3]
popj p,
;TDVFXL - clear rest of line and ask user for more.
;expects b to be set up
;t - PC to print if error msg
tdvfxl: move a,b ;FCB for printing
jrst tryagn
subttl APR trapper
;here is the routine we go to when trap happens
fxu==1b11 ;floating exponent underflow
fov==1b3 ;floating overflow
ndv==1b12 ;no divide
aprerr: ;This routine is taken from FOROTS
move ac0,.jbtpc## ;get the error PC
hrrz ac1,ac0 ;see if it is OK (in runtime)
cail ac1,safbeg## ;[7] see if it is in runtime
caile ac1,safend## ;[7]
jrst .+2 ;[7] no
jrst ignore ;[7] it's OK
skipe in.ddt ;[17] in debugger?
jrst ignore ;yes - ignore it
hlrz ac1,ac0 ;store flags in RH(1)
tlz ac0,(ndv!fov!fxu) ;clear error bits
andi ac1,(fxu!fov!ndv) ;clear all except these flags
lsh ac1,-5 ;right justify ndv flag(if set)
trze ac1,(1b8) ;fov set?
iori ac1,1b33 ;yes--copy to another place
outstr [asciz /
? /]
outstr @aprtab(ac1) ;put out appropriate message
pushj p,runer. ;now go to PASCAL PC printer
;jrst ignore ;and continue if it returns
ignore: movei ac1,110 ;reenable APR trapper
aprenb ac1,
jrstf @.jbtpc## ;return to pgm, error flags still set
aprtab: [asciz /Integer overflow/]
[asciz /Integer divide check/]
[0]
[0]
[asciz /Floating overflow/]
[asciz /Floating divide check/]
[asciz /Floating underflow/]
[0]
subttl FCB allocation
;initb. - make file control block be fresh and clean
; b - addr of fcb
;saves all ac's
initb.: push p,a
;We must enter this into the table of known blocks before setting
; filtst, in order to prevent a race condition if the user ^C's
; and restarts during this routine. We must make sure that the
; code as pasin1 knows to clear filtst.
;enter it into the table of known blocks
hrli a,-blklen ;aobjn word for searching block table
hrri a,blklck ;we are actually searching table of locks
aose (a) ;take it if free. Skip if it worked
;This code is designed to be reentrant, so
;a single instruction must test and take it
aobjn a,.-1 ;failed, try again
jumpge a,initbf ;failed to find an index location
movem b,blktab-blklck(a) ;found it, save block addr
movei a,blktab-blklck(a) ;and update high-water mark
camle a,lstblk
movem a,lstblk
;init the block
initbc: hrli a,protob ;blt prototype block to it
hrr a,b
blt a,filcmp(b)
movei a,filcmp(b) ;now initializations that depend upon address
movem a,filptr(b)
movem a,filcnt(b) ;don't have info to set up LH yet
pop p,a
popj p,
initbf: pushj p,blktbe ;print error message
jrst initbc ;init the block anyway if he says to
;init.b - special entry to reinit an exisiting block
init.b: push p,a
jrst initbc
;prototype block
protob:
exp 0 ;FILPTR= 0 ;pointer to filcmp
exp 0 ;FILEOF= 1 ;input: 0 = normal state
; 1 = eof or error - no more data in file (some
; errors will allow reading to continue, and
; thus will NOT set FILEOF)
;output:1 = normal state
; 0 = error (but program will abort so this will
; never show up)
exp 0 ;FILEOL= 2
;filr11= 3
exp unopn;filget= 3
exp unopn;filput= 4
exp notopx;filr99= 5
exp 0 ;filadv= 6
exp 1 ;filbad= 7
exp 0 ;filchn=10
exp 0 ;FILSTA=11 ; .+0 FOR FILESTATUS
exp 0 ;FILDEV=12 ; .+1 FOR DEVICE
exp 0 ;FILBFP=13 ; .+2 FOR POINTER TO BUFFERHEADER
exp 0 ;FILNAM=14
exp 0 ;FILEXT=15
exp 0 ;FILPRO=16
exp 0
exp 0 ;FILPPN=20
exp 0,0,0,0,0
exp 0 ;FILBFH=26 ;BUFFER HEADER
exp 0 ;FILBTP=27 ;BYTE POINTER
exp 0 ;FILBTC=30 ;BYTE COUNT IN BUFFER
exp 0 ;FILLNR=31 ;IF ASCII MODE - LINENR IN ASCIICHARACTERS
exp 0 ;FILCNT=32 ;LH= if non-text file: neg. number of words in comp.
; if text file: zero
;test sign bit of this loc to see if an ASCII file
;RH= ADDRESS OF FIRST WORD IN COMPONENT
exp 0 ;filphb=33 ;last physical block input or output
exp 0 ;filrcs=34 ;LH=physical block size, bytes
;RH=size of last record input or output, bytes
exp 0 ;filerr=35 ;LH= errors that have happened; RH=errors allowed
exp 0 ;filst1=36 ;mode-dependent - usally bits in LH:
exp 0 ;filst2=37 ;mode-dependent
exp 314157 ;filtst=40 ;314157 if the file block is legal
exp 0 ;free
exp norchx ;filcht=42 ;character mapping table
exp 0 ;FILCMP=43 ;FIRST WORD OF COMPONENT
subttl file initialization
pasin.: jsp ac1,pasif. ;entry for old programs
popj p,
pasif.: move reg2,ac1 ;save ret addr
;if any files are left open, we clear filtst, to indicate that they
;need reinitialization
movei a,blktab ;loop through all files
pasin1: skipe b,(a) ;get the fcb addr there
setzm filtst(b) ;and indicate no longer valid
setzm (a) ;clear table entry
camge a,lstblk ;go to next, if any
aoja a,pasin1
setzm lstblk ;now nothing in use
setom blklck ;restore all to unlocked
move a,[xwd blklck,blklck+1]
blt a,blklck+blklen-1
setom in.use ;free all channels
move ac0,[xwd in.use,in.use+1]
blt ac0,in.use+17
setzm buflst ;and note no buffer free list
jrst (reg2)
pasim.: move ac0,[xwd 112,11] ;[2] set up mon.tp so we know what
gettab ac0, ;[2] operating sys. we are on
movei ac0,10000 ;[2] assume tops-10 if fails
ldb ac0,[point 6,ac0,23] ;[2] monitor type field
movem ac0,mon.tp ;[2]
cain ac0,1 ;if not tops-10
jrst pasim1 ;is tops-10, forget this
move reg,.jbhrl ;the following will change .jbhrl
move ac0,[xwd 677777,377777] ;allocate all of memory
core ac0, ;so we can put arg's to UUO's on stack
jfcl
movem reg,.jbhrl ;we don't want it changed
pasim1: setzm in.ddt ;[17]
setzm in.crt
setzm avail##
setzm avail+1
setzm begmem##
setzm endmem##
ife ka10sw,<
jrst (ac1) ;[2]
> ;ife ka10sw
;[17] begin new init code for KA
ifn ka10sw,<
move newreg,lstnew ;value of /HEAP
cain newreg,0 ;if defaulted
movei newreg,4000 ;use 4 pages
skipe wrk.sz ;if he specified size in reenter
move newreg,wrk.sz ;use it instead
add newreg,.jbff ;15 _ new .jbff
move ac0,.jbff ;ac0 _ old .jbff, start of stack
movem newreg,.jbff ;put in new .jbff
move b,mon.tp ;what monitor are we on?
caie b,1 ;if on tops-10
jrst pasim2 ; tops-20 or tenex, we already have it
core newreg, ;get the core
jrst nocore
pasim2: move newreg,.jbff ;core UUO garbaged newreg
hrrz basis,basis ;find offset between 17 and 16
hrrz p,p
sub p,basis ;17 _ offset
move basis,ac0 ;16 _ first loc in stack
hrl basis,basis
add p,ac0 ;17 _ that + offset
hrl p,p
movem basis,%rndev##+3 ;save 16 and 17 in globbasis and globtopp
movem p,%rndev##+2
jrst (ac1)
nocore: outstr [asciz /
? Can't allocate initial core request
/]
exit
corall: outstr [asciz /
Number of words to assign to stack+heap: /]
setzb ac1,ac0
coralp: inchwl ac0
cail ac0,60 ;better be a digit
caile ac0,71
jrst coralx
subi ac0,60
imuli ac1,^D10 ;add into number being built up
add ac1,ac0
jrst coralp ;and try for another digit
coralx: caie ac0,15 ;should end in cr
jrst corale
inchwl ac0 ;read lf
movem ac1,wrk.sz ;store final value
outstr [asciz /[Size set - START or SAVE the program]
/]
exit
corale: outstr [asciz /
? Type a decimal number, end with CRLF
/]
clrbfi
jrst corall
> ;ifn ka10sw
subttl misc. data
;**PLATZ FUER LITERALS ** - XLISTED
XLIST
LIT
LIST
reloc
updblk: exp 5
block 4
updlen: block 1
blklen==40 ;There are only 20(8) channels
blklck: block blklen
blktab: block blklen
lstblk: block 1
in.use: repeat 20,<
exp -1>
buflst: block 1 ;header of list of free buffers
;What is actually on this list is a list of whole
;buffer rings. The addresses refer to word 0 of
;the first buffer in the ring. Word +1 is the
;address of the next entry in the list. Word -1
;is the buffer count as size as returned by BUFSIZ
lstnew: 0 ;last location used by NEW
newbnd: 0 ;lowest legal location for NEW
stkexp: exp 1 ;page. block for expanding stack
exp 0 ; place for page to create
heaexp: exp 1 ;ditto for expanding heap
exp 0
mon.tp: exp 1 ;[2] type of system (1=tops10,3=tenex,4=tops20)
in.ddt: 0 ;[17] 1 if in pasddt
in.crt: 0 ;negative if in critical section
ifn ka10sw,<
wrk.sz: 0 ;[17] size of work area (heap+stack) specified by reenter
> ;ifn ka10sw
subttl magic locations
;set up the APR trap
.jbapr=125
loc .jbapr
exp aprerr
ifn ka10sw,<
;set up the REENTER address
.jbren==124
loc .jbren
exp corall
> ;ifn ka10sw
prgend
TITLE NEW ; FAKE ENTRY IN CASE DISPOSE NOT INCLUDED
SEARCH PASUNV
ENTRY NEW
NEW=GETNEW##
TWOSEG
RELOC 0
AVAIL:: BLOCK 2
BEGMEM::BLOCK 1
ENDMEM::BLOCK 1
RELOC 400000
PRGEND
title PASCHN - allocate/deallocate channels
;This is done as a separate module to allow for the fortran interface.
;The interface will include its own version of these which call the
;fortran channel allocator/deallocator.
twoseg 400000
search pasunv
entry fn.chn,lo.chn
external in.use
fn.chn: hrlzi ac1,-17 ;find free channel - search 1 to 17 first
hrri ac1,in.use+1 ;inuse(ch)=-1 if free, .ge. 0 if used
aose (ac1) ;take it if free. Skip if it worked
;This may seem obscure, but the idea is to test if free and
;allocate the channel in the same instruction,
;so we are interruptible
aobjn ac1,.-1 ;failed, try again
jumpl ac1,chnfnd ;loop not exhausted - found it
aose in.use ;1-17 used, try 0
jrst chnnfd ;nope - none found
setz ac1, ;yes - return 0
popj p,
chnfnd: hrrz ac1,ac1 ;get channel found
subi ac1,in.use
popj p,
chnnfd: seto ac1, ;-1 means none found
popj p,
lo.chn: setom in.use(ac1) ;lose channel
popj p,
prgend
title DUMCRI - dummy critical section, if no PSI
entry leavec,enterc
twoseg
reloc 400000
leavec:
enterc: popj 17,
prgend
title DANGER - routine for dummy label when pasnum not loaded
entry safbeg,safend
safbeg: block 0
safend: block 0
END