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 ;36 - fix to allow programs to go virtual TWOSEG 400000 if1, ;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== %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: hrrz ac0,stkexp+1 ;[36] 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: hrrz ac0,heaexp+1 ;[36] 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, ;real letter define lc, ;upper case equiv. of lower case letter define linech(x), ;end of line char norcht: beg==norcht repeat 12, ;0 - 11 linech 1 ;12 letter ;13 linech 1 ;14 linech -1 ;15 repeat 14, ;16 - 31 linech 1 ;32 linech 1 ;33 repeat 166, ;everything else is a letter lccht: beg==lccht repeat 12, linech 1 letter linech 1 linech -1 repeat 14, linech 1 linech 1 ;33 repeat 105, ;34 - 140 repeat 32, ;141 - 172 repeat 5, ;173 - 177 ;Here are the tables that don't show you end of line define linech(x), ;end of line char norchx: beg==norchx repeat 12, ;0 - 11 linech 1 ;12 letter ;13 linech 1 ;14 linech -1 ;15 repeat 14, ;16 - 31 linech 1 ;32 linech 1 ;33 repeat 166, ;everything else is a letter lcchx: beg==lcchx repeat 12, linech 1 letter linech 1 linech -1 repeat 14, linech 1 linech 1 ;33 repeat 105, ;34 - 140 repeat 32, ;141 - 172 repeat 5, ;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 ; PUSHJ P,PUTCH MOVEI AC0 ,14 ; 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== ;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