Tops-20 version PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1 PASIO MAC 7-Mar-81 20:52 title PASIO - I/O routines for TOPS-20 Pascal ;edit history - begins with edit 2 ;2 - keep disk open from blowing up when file has byte size of 0 ;3 - improve recovery from arithmetic errors ;4 - set up to process pushdown overflow ;5 - Tenex ;6 - replace pasin. by pasif., which doesn't use pushj, in case ; emulator is active (as it is for tenex) ;7 - more Tenex, convert some more erjmp's to erjrst, gnjfx1 ; end of line for tty I/O ; tty openned as file should still use pstin ;10 - add multiple page buffers. This involves major edits to the ; whole map I/O section, getpag/relpag, and the callers thereof ; I have not put edit numbers on this edit. ;11 - remove DMOVE, for KA Tenex ;12 - mark file as unopened after closing it ;13 - fix open of TTY and TTYOUTPUT, since edit 12 broke it ;14 - general Tenex TTY I/O, supposedly the INTERLISP-style line ; Few TENEX sites support the PSTIN JSYS. ;15 - fix up what we do on errors a bit ;16 - use GET. instead of GET; don't look for line numbers unless ; first word of file is line numbered (undone in edit 23, except SRI) ;17 - don't do line number test for size=0. For version 1 monitors. We ; would get ill mem read, since ERJMP didn't always work in version 1. ;20 - replace newpage,retpage with getpages,relpages. Move old ones to PASOLD ;21 - Add code for Tenex with PA2040 ;22 - fix f%ltst routine so it doesn't need to use BKJFN, since that won't ; work for tapes [monitor bug]. NB: Originally, we tested every word ; in the file to see if it was a line number. I still prefer that code. ; The business of testing the first word and turning off the test if it ; is not a line number is done strictly for SRI. The code is ugly, in ; in case of errors in reading the first word, who knows what to do? ; The reason SRI needs it is because their version of EMACS randomly ; sets the low order bit in files it creates. ;23 - put funny line number testing under SRI conditional ;24 - add code for dynamic heap management (DDyer@USC-ISIB) ;25 (DFloodPage@BBNE) use non-binary mode in RDSTR on Tenex ; Don't set bit zero in chfdb on Tenex ;26 - missing PSOUT of prompt in error handling ;27 - all continuation after quota exceeded. This is a "temporary" fix. ; A more general redesign to allow continuation in all cases ; is in PASIO.NEW. However it is going to be a bear to debug, so ; this patch is being used as a safe one that does the job. ;30 - replace WRTPC with RUNERR, that allows continuation ;31 - new routines - SHOWLN and FIXLN ;32 - add TTYPR. - prompt for INPUT open on TTY: ;33 - retry opens when something goes wrong ;34 - new intelligible form for funny open options ;35 - minor fix to maperr, for holes in file ;36 - removed setting EOLN in CLREOF ;37 - typo: had move instead of movei at HAVSPC ;40 - handle zero counts for SOUT, SOUTR, and SINR ;41 - fix bad stack offset PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1-1 PASIO MAC 7-Mar-81 20:52 ;42 - fix CLREOF - AC 2 was being garbaged sall ;no macro bodies or repeats search monsym,pasunv if1,< ife tenex, ifn tenex,< ifn sumex, ife sumex,< ifn pa2040, ife pa2040, >;ife sumex >;ifn tenex ifn srisw, ;[23] >;if1 601054 gnjfx1=601054 ;[7] T20 calls this gnjfx1, Tenex gnjfx2. In ;[7] Tenex gnjfx1 is something else. So this ;[7] definition should let us transport the code. ifn sumex,< opdef pstin [jsys 611] ;[14] SUMEX has PSTIN, so does IMSSS, but nowheres ;[14] else is it guaranteed! Thus, where the ;[14] SUMEX switch is not, we simulate the ;[14] INTERLISP string reading stuff > 000004 mapbfs==4 ;default number of pages in buffer for mapped I/O ifn tenex, ;except for Tenex, no advantage to more than 1 ;[the code should work for .gt. 1 even in tenex, though] 000001 oldcom==1 ;kludges needed to run this with .rel files made ;by the tops-10 compiler (alas, I have never removed ;the last vestiges of this program structure. So this ;switch is mostly a comment showing what should be ;cleaned up.) entry initb.,init.b entry endl,runer.,gotoc.,dispc.,ilfil. entry resetf,rewrit,getch,get.,putch,put,clofil,getchr entry getfn.,getln,putln,putpg,getlnx,putlnx,putpgx entry putx,getx.,break,breaki entry setpos,curpos entry pasin.,pasif.,end,quit,clreof,getpg. entry newbnd,corerr,lstnew,illfn,norcht,norchx entry inxerr,ptrer.,srerr entry getnew,newcl. entry rename,delf.,append,update,resdev,relf.,nextfi entry erstat,analys,lstrec entry ttypr. 400000' twoseg 000000' reloc 0 000000' frepag: block 17 ;array of bits to indicate free pages PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1-2 PASIO MAC 7-Mar-81 20:52 000017' lstnew: block 1 ;last location used by new ifn oldcom,< 000020' newbnd: block 1 ;dummy for tops-10 code > ;ifn oldcom 400000' reloc 400000 ife tenex,< ;[27] ; ;CHKQUO should be used after any JSYS that might get a disk quota overflow. ; Note that it can be followed by an ERCAL or ERJMP, which will activate ; if any other error condition is present. ;CHKQUO should not be used after ILDB or IDPB. ERCAL MAPERR is the ; canonical error handler for that. MAPERR handles quota errors itself. define chkquo,< ercal quochk> > ;ife tenex ifn tenex,< define chkquo,<> ;[27] ife sumex,< ; TENEX GETER loads 4-10 with PSB define geter,< pushj p,.geter > .geter: push p,4 push p,5 push p,6 push p,7 push p,10 jsys 12 ; geter pop p,10 pop p,7 pop p,6 pop p,5 pop p,4 popj p, > > ifn oldcom,< ;This routine will be called once in initialization to create core ;for the beginning of the stack. After that core will be created ;automatically, as the nxm interrupt will be off. 400000' 200 04 0 00 000001 corerr: move d,a ;save return address 400001' 201 01 0 00 400000 movei a,400000 ;current process 400002' 201 02 0 00 020000 movei 2,1b22 ;nxm interrupt 400003' 104 00 0 00 000133 dic ;disable interrupt 400004' 200 01 0 17 000000 move a,(p) ;reference the location 400005' 201 15 0 00 777777 movei n,777777 ;set so we are never called again 400006' 254 00 0 04 000000 jrst (d) ;return > ;ifn oldcom 400007' 210 01 0 00 000002 GETNEW: movn a,b ;must be interruptible 400010' 273 01 0 00 000017' addb a,lstnew ;get new addr and update lstnew at once 400011' 306 01 0 00 377777 cain a,377777 ;if result is nil 400012' 254 00 0 00 400017' jrst newnil ; get another one! 400013' 315 01 0 00 000000* camge a,.jbff## ;overlap low? 400014' 254 00 0 00 400035' jrst nonew ;yes, nothing there 400015' 200 02 0 00 000001 newxit: move b,a PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1-3 PASIO MAC 7-Mar-81 20:52 400016' 263 17 0 00 000000 popj p, 400017' 307 02 0 00 000000 newnil: caig b,0 ;if size 0, adjust to 1 so we go somewhere 400020' 201 02 0 00 000001 movei b,1 400021' 254 00 0 00 400007' jrst getnew ;and try again 400022' 261 17 0 00 000002 newcl.: push p,b ;here to clear result 400023' 260 17 0 00 000000* pushj p,new## 400024' 262 17 0 00 000002 pop p,b 400025' 323 02 0 00 400015' jumple b,newxit ;if 0, nothing to clear 400026' 402 00 0 01 000000 setzm (a) ;clear first 400027' 363 02 0 00 400015' sojle b,newxit ;anything else to clear? 400030' 270 02 0 00 000001 add b,a ;last address 400031' 505 00 0 01 000000 hrli t,(a) ;first address 400032' 541 00 0 01 000001 hrri t,1(1) ;make blt for clear 400033' 251 00 0 02 000000 blt t,(b) 400034' 254 00 0 00 400015' jrst newxit ;Here if nothing more available 400035' 200 00 0 17 000000 nonew: move t,(p) ;this is addr for error printer 400036' 260 17 0 00 400131' pushj p,newerr 400037' 201 02 0 00 377777 movei b,377777 ;return NIL if he tries to continue 400040' 263 17 0 00 000000 popj p, define outstr(x),< hrroi a,x psout > define eoutstr(x),< hrroi a,x esout > ;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. 000021' reloc 000021' ddtgo: block 1 000022' erracs: block 20 400041' reloc 400041' 202 00 0 00 000022' runer.: movem 0,erracs ;save the AC's 400042' 200 00 0 00 406502' move 0,[xwd 1,erracs+1] 400043' 251 00 0 00 000041' blt 0,erracs+17 400044' 200 00 0 00 000022' move 0,erracs 400045' 561 01 0 00 406503' outstr [asciz / at user PC /] 400046' 104 00 0 00 000076 400047' 104 00 0 00 000076 psout ;print PC in octal PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1-4 PASIO MAC 7-Mar-81 20:52 400050' 551 04 0 00 000006 HRRZI d, 6 400051' 200 05 0 00 406506' MOVE e,[POINT 3,t,17] 400052' 134 01 0 00 000005 ILDB a, e 400053' 271 01 0 00 000060 ADDI a, 60 400054' 104 00 0 00 000074 pbout 400055' 367 04 0 00 400052' SOJG d,.-3 ;go to debugger if there is any 400056' 550 03 0 00 000000* HRRZ c,.JBDDT## ;[3] LOAD PASDDT-ADDR 400057' 322 03 0 00 400065' JUMPE c,noddt ;[3] no .jbddt, maybe vmddt 400060' 200 03 0 00 400056* move c,.jbddt## ;[3] want left half, too 400061' 623 03 0 00 777777 tlze c,777777 ;[3] if zero, it is PASDDT 400062' 254 00 0 00 400074' jrst decddt ;[3] if not, real DDT ;PASDDT 400063' 260 17 0 03 777777 pushj p,-1(c) ;[3] go to pasddt special entrance 400064' 254 00 0 00 400113' jrst errest ;continue if he continues ;nothing obvious - check for VM DDT or just halt 400065' 200 01 0 00 406507' noddt: move a,[xwd 400000,770] ;[3] no .jbddt, see if 770000 400066' 104 00 0 00 000057 rpacs ;[3] page exist? 400067' 607 02 0 00 010000 tlnn b,(pa%pex) ;[3] 400070' 254 00 0 00 400105' jrst hlterr ;[3] no - continue 400071' 607 02 0 00 020000 tlnn b,(pa%ex) ;[3] allowed to execute? 400072' 254 00 0 00 400105' jrst hlterr ;[3] no - continue ;DDT 400073' 201 03 0 00 770000 movei c,770000 ;[3] seems to be ddt - get its addr 400074' 202 00 0 00 000000* decddt: movem t,.jbopc## ;save PC so he can continue 400075' 552 03 0 00 000021' hrrzm c,ddtgo outstr [asciz / [Type POPJ 17,$X to continue if possible QUIT$G to close files and exit] 400076' 561 01 0 00 406510' /] 400077' 104 00 0 00 000076 400100' 200 00 0 00 406531' move 0,[xwd erracs+1,1] ;restore ac's to pgm context 400101' 251 00 0 00 000016 blt 0,16 400102' 200 00 0 00 000022' move 0,erracs 400103' 260 17 1 00 000021' pushj p,@ddtgo ;[3] avoid -1 entry point! 400104' 254 00 0 00 400113' 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, REENTER to close all files and exit] 400105' 561 01 0 00 406532' /] 400106' 104 00 0 00 000076 400107' 201 01 0 00 405203' movei a,quit 400110' 250 01 0 00 000000* exch a,.jbren## 400111' 104 00 0 00 000170 haltf 400112' 202 01 0 00 400110* movem a,.jbren ; jrst errest ;here to continue if the user really wants to 400113' 200 00 0 00 406531' errest: move 0,[xwd erracs+1,1] 400114' 251 00 0 00 000017 blt 0,17 400115' 200 00 0 00 000022' move 0,erracs 400116' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 1-5 PASIO MAC 7-Mar-81 20:52 400117' 561 01 0 00 406554' ilfil.: eoutstr [ASCIZ /Uninitialized file/] 400120' 104 00 0 00 000313 400121' 200 00 0 17 000000 move t,(p) 400122' 260 17 0 00 400041' pushj p,runer. 400123' 201 02 0 00 000000* movei b,tty## ;use tty instead 400124' 263 17 0 00 000000 popj p, 400125' 561 01 0 00 406560' INXERR: eoutstr [ASCIZ /Array index out of bounds/] 400126' 104 00 0 00 000313 400127' 260 17 0 00 400041' pushj p,runer. 400130' 254 00 1 00 000000 jrst @t 400131' 561 01 0 00 406566' newerr: eoutstr [asciz /No memory for heap/] 400132' 104 00 0 00 000313 400133' 260 17 0 00 400041' pushj p,runer. 400134' 263 17 0 00 000000 popj p, 400135' 561 01 0 00 406572' PTRER.: eoutstr [ASCIZ /Uninitialzed or NIL pointer/] 400136' 104 00 0 00 000313 400137' 260 17 0 00 400041' pushj p,runer. 400140' 254 00 1 00 000000 jrst @t 400141' 561 01 0 00 406600' SRERR: eoutstr[ASCIZ/Scalar out of range/] 400142' 104 00 0 00 000313 400143' 260 17 0 00 400041' pushj p,runer. 400144' 254 00 1 00 000000 jrst @t 400145' 261 17 0 00 000000 blktbe: push p,t 400146' 400 00 0 00 000000 setz t, ;we don't know the location 400147' 561 01 0 00 406604' eoutstr[ASCIZ/Too many files open at once/] 400150' 104 00 0 00 000313 400151' 260 17 0 00 400041' pushj p,runer. 400152' 262 17 0 00 000000 pop p,t 400153' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 2 PASIO MAC 7-Mar-81 20:52 file openning - top level routines subttl file openning - top level routines ;ac usage for the file openning routines: ; t,a - temporary ; b - fcb ; c - string (file spec) ; d - length of string ; e - protection/interactive ; f - gtjfn word or 0 ; g - openf word or 0 ; h - bits: ; fl%lc (1) map lower case ; fl%ioe (2) handle i/o errors ; fl%fme (4) handle data format errors ; fl%ope (10) handle open errors ; fl%eol (20) show end of line char ; fl%buf (7700) number of buffers or pages ; fl%mod (770000) I/O type ; fm%byt(1) bin/bout ; fm%map(2) pmap ; fm%tty(3) texti/bout ; fm%nul(4) popj ; fm%wrd(5) buffered 36 bit ; fm%chr(6) buffered logical byte size ; fm%lst last legal mode ;places to save f and g for retry 000037 filsvf==filst5 000030 filsvg==fils21 ;The following define flags we can't let the user play with. We set ; flags first by zeroing these and then doing tlc with those we want ; to set. This results in the settings needed for the bits listed ; here, but lets the user clear others that we set by specifying ; them in his argument. 000665 000000 gj%reg==gj%flg!gj%sht!gj%jfn!gj%ofg!gj%xtn 360000 of%reg==of%rd!of%wr!of%ex!of%app 400154' 201 00 0 00 000000 resetf: movei t,0 ;eof setting for correct operation 400155' 260 17 0 00 400325' pushj p,setprm ;initialize fcb 400156' 621 06 0 00 000665 tlz f,(gj%reg) 400157' 641 06 0 00 100021 tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn 400160' 620 07 0 00 360000 trz g,of%reg 400161' 640 07 0 00 200000 trc g,of%rd ;extra bits for openf 400162' 260 17 0 00 401357' pushj p,getjfn 400163' 260 17 0 00 400555' pushj p,devprm ;device-dependent parameter setting 400164' 200 01 0 02 000023 pcall f%open 400165' 260 17 1 01 000006 400166' 200 01 0 02 000023 pcall f%ltst 400167' 260 17 1 01 000010 400170' 260 17 0 00 401332' pushj p,errchk ;if open errors 400171' 254 00 0 00 400154' jrst resetf ;then try again 400172' 574 03 0 02 000032 hlre c,filcnt(b) ;get count in case record I/O 400173' 210 03 0 00 000003 movn c,c ;is negative 400174' 322 05 1 02 000016 jumpe e,@filget(b) ;if not interactive, get 1st thing PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 2-1 PASIO MAC 7-Mar-81 20:52 file openning - top level routines 400175' 336 00 0 02 000003 skipn filerr(b) ;any errors in openning? 400176' 350 00 0 02 000002 aos fileol(b) ;no - set dummy eoln for interactive begin 400177' 263 17 0 00 000000 cpopj: popj p, 400200' 201 00 0 00 000000 update: movei t,0 ;eof setting for correct operation 400201' 260 17 0 00 400325' pushj p,setprm ;initialize fcb 400202' 621 06 0 00 000665 tlz f,(gj%reg) 400203' 641 06 0 00 100021 tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn 400204' 620 07 0 00 360000 trz g,of%reg 400205' 640 07 0 00 300000 trc g,of%rd!of%wr ;extra bits for openf 400206' 260 17 0 00 401357' pushj p,getjfn 400207' 260 17 0 00 400555' pushj p,devprm ;device-dependent parameter setting 400210' 200 01 0 02 000023 pcall f%open 400211' 260 17 1 01 000006 400212' 200 01 0 02 000023 pcall f%ltst 400213' 260 17 1 01 000010 400214' 260 17 0 00 401332' pushj p,errchk ;errors? 400215' 254 00 0 00 400200' jrst update ; yes - try again 400216' 336 00 0 02 000003 skipn filerr(b) ;any errors in openning? 400217' 350 00 0 02 000002 aos fileol(b) ;no - set dummy eoln for interactive begin 400220' 263 17 0 00 000000 popj p, 400221' 201 00 0 00 000001 rewrit: movei t,1 ;eof setting for correct operation 400222' 260 17 0 00 400325' pushj p,setprm ;initialize fcb 400223' 621 06 0 00 000665 tlz f,(gj%reg) 400224' 641 06 0 00 400021 tlc f,(gj%fou!gj%flg!gj%sht) ;extra bits for gtjfn 400225' 620 07 0 00 360000 trz g,of%reg 400226' 640 07 0 00 100000 trc g,of%wr 400227' 260 17 0 00 401357' pushj p,getjfn 400230' 260 17 0 00 400555' pushj p,devprm ;device-dependent parameter setting 400231' 200 01 0 02 000023 pcall f%open 400232' 260 17 1 01 000006 400233' 260 17 0 00 401332' pushj p,errchk ;errors 400234' 254 00 0 00 400221' jrst rewrit ;yes - try again 400235' 263 17 0 00 000000 popj p, 400236' 201 00 0 00 000001 append: movei t,1 ;eof setting for correct operation 400237' 260 17 0 00 400325' pushj p,setprm ;initialize fcb 400240' 621 06 0 00 000665 tlz f,(gj%reg) 400241' 641 06 0 00 100021 tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn 400242' 620 07 0 00 360000 trz g,of%reg 400243' 640 07 0 00 020000 trc g,of%app 400244' 260 17 0 00 401357' pushj p,getjfn 400245' 260 17 0 00 400555' pushj p,devprm ;device-dependent parameter setting 400246' 200 01 0 02 000023 pcall f%open 400247' 260 17 1 01 000006 400250' 260 17 0 00 401332' pushj p,errchk ;errors? 400251' 254 00 0 00 400236' jrst append ;yes - try again 400252' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 3 PASIO MAC 7-Mar-81 20:52 rename and delete subttl rename and delete 400253' 261 17 0 02 000004 rename: push p,filjfn(b) ;save old jfn 400254' 261 17 0 00 000002 push p,b 400255' 261 17 0 00 000003 push p,c 400256' 205 03 0 00 400000 movsi c,(co%nrj) ;close but leave jfn 400257' 260 17 0 00 401563' pushj p,doclos 400260' 262 17 0 00 000003 pop p,c 400261' 262 17 0 00 000002 pop p,b 400262' 402 00 0 02 000001 setzm fileof(b) ;assume it is OK 400263' 402 00 0 02 000003 setzm filerr(b) ;so getjfn works 400264' 621 06 0 00 000665 tlz f,(gj%reg) 400265' 641 06 0 00 400021 tlc f,(gj%fou!gj%flg!gj%sht) 400266' 260 17 0 00 401357' pushj p,getjfn ;get new jfn 400267' 332 00 0 02 000003 skipe filerr(b) ;if error, stop now 400270' 254 00 0 00 400303' jrst rener1 400271' 200 10 0 00 000002 move h,b ;protect fcb and put where doope wants 400272' 262 17 0 00 000001 pop p,a ;old jfn 400273' 621 01 0 00 777777 tlz a,-1 400274' 550 02 0 10 000004 hrrz b,filjfn(h) ;new jfn 400275' 104 00 0 00 000035 rnamf 400276' 320 16 0 00 400300' erjrst rener ;[7] 400277' 263 17 0 00 000000 popj p, 400300' 552 01 0 10 000003 rener: hrrzm a,filerr(h) ;this is error code 400301' 350 00 0 10 000001 aos fileof(h) ;set eof 400302' 263 17 0 00 000000 popj p, 400303' 201 01 0 00 000001 rener1: movei a,1 400304' 202 01 0 10 000001 movem a,fileof(h) ;set eof 400305' 263 17 0 00 000000 popj p, 400306' 261 17 0 02 000004 delf.: push p,filjfn(b) 400307' 261 17 0 00 000002 push p,b 400310' 261 17 0 00 000003 push p,c 400311' 205 03 0 00 400000 movsi c,(co%nrj) 400312' 260 17 0 00 401563' pushj p,doclos 400313' 262 17 0 00 000003 pop p,c 400314' 262 17 0 00 000002 pop p,b 400315' 402 00 0 02 000001 setzm fileof(b) 400316' 402 00 0 02 000003 setzm filerr(b) 400317' 262 17 0 00 000001 pop p,a 400320' 505 01 0 00 400000 hrli a,(df%nrj) ;keep the jfn 400321' 200 10 0 00 000002 move h,b ;where rener needs it 400322' 104 00 0 00 000026 delf 400323' 320 16 0 00 400300' erjrst rener ;[7] 400324' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 4 PASIO MAC 7-Mar-81 20:52 low level routines for file openning subttl low level routines for file openning ;AC usage for setprm: ; t - at entry, this is normal setting of eof ; a - length of file component, 0 if text ; b - fcb pointer ; c - lh=flags, rh=addr of file spec ; d - length of file spec ; e - 0 or 1 - interactive flag; more commonly - new funny option string ; h - flags ; t,a garbaged ;setprm handles all device-independent file-openning stuff, ;including initializing the fcb so all entries are valid for I/O. ;In case of error, filerr is set, so the caller had better check ;this. Byte size and I/O routines are left for devprm, as they ;are device-dependent. 400325' setprm: ;First we make sure we have a valid FCB 400325' 261 17 0 00 000000 push p,t 400326' 200 00 0 02 000040 move t,filtst(b) 400327' 302 00 0 00 314157 caie t,314157 ;magic word will be there if it is legal 400330' 260 17 0 00 405414' pushj p,initb. ;not - init it 400331' 262 17 0 00 000000 pop p,t ;We do any format conversions before saving away the values ifn oldcom,< 400332' 316 10 0 00 406612' camn h,[-1] ;old compiler uses -1 as default 400333' 400 10 0 00 000000 setz h, ;should be 0 > ;ifn oldcom 400334' 312 05 0 00 406612' came e,[exp -1] ;-1 or 0 LH is probably old format 400335' 607 05 0 00 777777 tlnn e,777777 400336' 254 00 0 00 400340' jrst setpr1 ;old format 400337' 260 17 0 00 400412' pushj p,option ;new format parse options ;now save values in case of restart. Note that format conversions won't be ;redone in case of restart since LH(e) is now 0, and h is not longer -1 400340' 202 06 0 02 000037 setpr1: movem f,filsvf(b) ;save args for error recovery 400341' 202 07 0 02 000030 movem g,filsvg(b) ; h is also saved, below - e is not touched 400342' 202 00 0 02 000001 movem t,fileof(b) ;put in a few args 400343' 640 00 0 00 000001 trc t,1 ;this is the eof to set if errors 400344' 202 00 0 02 000007 movem t,filbad(b) 400345' 210 01 0 00 000001 movn a,a ;filcnt wants negative count 400346' 504 01 0 00 000001 hrl a,a ; in left, 400347' 541 01 0 02 000043 hrri a,filcmp(b) ; with addr of buffer in RH 400350' 202 01 0 02 000032 movem a,filcnt(b) ;the following code is intended to set both H and FILFLG to ; H*(-20) + FILFLG*20. 400351' 620 10 0 00 000040 trz h,fl%tmp ;H * (-20) 400352' 250 10 0 02 000006 exch h,filflg(b) ;reverse them so we can play with FILFLG 400353' 405 10 0 00 000040 andi h,fl%tmp ;FILFLG * 20 400354' 437 10 0 02 000006 iorb h,filflg(b) ;both _ H * (-20) + FILFLG * 20 ;here we figure out which character table to use 400355' 201 01 0 00 000000 movei a,0 ;assume no lc map, standard EOL treatment 400356' 602 10 0 00 000001 trne h,fl%lc ;if lc mapping on 400357' 660 01 0 00 000002 tro a,2 ;set bit 2 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 4-1 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400360' 602 10 0 00 000020 trne h,fl%eol ;if we want to see EOL char 400361' 660 01 0 00 000001 tro a,1 ;set bit 1 400362' 200 00 0 01 406613' move t,[exp norchx,norcht,lcchx,lccht](a) ;get the right table 400363' 505 00 0 00 000001 hrli t,a ;indexed on this ac 400364' 202 00 0 02 000010 movem t,filcht(b) ;now random initialization 400365' 201 01 0 02 000043 movei a,filcmp(b) 400366' 202 01 0 02 000000 movem a,filptr(b) 400367' 200 01 0 00 406617' move a,[ascii /-----/] ;initial line number 400370' 202 01 0 02 000031 movem a,fillnr(b) 400371' 261 17 0 00 000003 push p,c 400372' 205 03 0 00 400000 movsi c,(co%nrj) ;assume we use existing jfn 400373' 336 00 0 00 000004 skipn d ;unless new file spec 400374' 335 00 0 17 000000 skipge (p) ;or request to get spec from tty 400375' 400 03 0 00 000000 setz c, ; then full close 400376' 260 17 0 00 401563' pushj p,doclos ;close file if one already open ;becaue of code above, this also releases the jfn ;and zeros filjfn if the user gave us a new file spec 400377' 262 17 0 00 000003 pop p,c 400400' 402 00 0 02 000003 setzm filerr(b) ;now zero things 400401' 402 00 0 02 000002 setzm fileol(b) 400402' 402 00 0 02 000014 setzm fillts(b) 400403' 200 01 0 02 000032 move a,filcnt(b) ;zero the component 400404' 402 00 0 01 000000 setzm (a) 400405' 253 01 0 00 400404' aobjn a,.-1 ifn oldcom,< 400406' 302 02 0 00 400123* caie b,tty## ;special for tops-10 tty open, since 400407' 306 02 0 00 000000* cain b,ttyout## ;args are garbage 400410' 254 00 0 00 400547' jrst opntty > ;ifn oldcom 400411' 263 17 0 00 000000 popj p, ;no - done ;e - LH - count, RH - addr 400412' 261 17 0 00 000000 option: push p,t 400413' 261 17 0 00 000001 push p,a ;get some working space 400414' 261 17 0 00 000002 push p,b 400415' 554 01 0 00 000005 hlrz a,e ;a _ count 400416' 550 00 0 00 000005 hrrz t,e ;t _ byte ptr 400417' 400 05 0 00 000000 setz e, ;e is now one of the AC's we are setting up 400420' 505 00 0 00 440700 hrli t,440700 400421' 322 01 0 00 400437' jumpe a,optend 400422' 134 02 0 00 000000 optlop: ildb b,t ;b _ next char 400423' 302 02 0 00 000057 caie b,"/" ;use / to separate options 400424' 254 00 0 00 400541' jrst opterr ;error 400425' 363 01 0 00 400541' sojle a,opterr ;count /, there had better be letter following 400426' 134 02 0 00 000000 ildb b,t ;b _ option letter 400427' 360 01 0 00 000000 soj a, ;count the letter 400430' 303 02 0 00 000140 caile b,140 ;if lower case 400431' 275 02 0 00 000040 subi b,40 ;make it upper 400432' 301 02 0 00 000102 cail b,optmin ;if below first 400433' 303 02 0 00 000125 caile b,optmax ;or above last 400434' 254 00 0 00 400541' jrst opterr ;error 400435' 256 00 0 02 400341' xct opttab-optmin(b) ;appropriate processing routine 400436' 327 01 0 00 400422' jumpg a,optlop ;if any more char's, get next 400437' 262 17 0 00 000002 optend: pop p,b ;exit PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 4-2 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400440' 262 17 0 00 000001 pop p,a 400441' 262 17 0 00 000000 pop p,t 400442' 263 17 0 00 000000 popj p, 000102 optmin="B" 400443' 260 17 0 00 400502' opttab: pushj p,optbyt ;B - byte size 400444' 254 00 0 00 400541' jrst opterr ;C - undef 400445' 660 10 0 00 000002 tro h,fl%ioe ;D - data trans errors 400446' 660 10 0 00 000020 tro h,fl%eol ;E - show eoln 400447' 660 10 0 00 000004 tro h,fl%fme ;F - data format errors 400450' 254 00 0 00 400541' jrst opterr ;G - undef 400451' 254 00 0 00 400541' jrst opterr ;H - undef 400452' 201 05 0 00 000001 movei e,1 ;I - set interactive flag repeat "M"-"J",< jrst opterr> ;J to L - undef 400453' 254 00 0 00 400541' 400454' 254 00 0 00 400541' 400455' 254 00 0 00 400541' 400456' 260 17 0 00 400467' pushj p,optmod ;M - mode 400457' 254 00 0 00 400541' jrst opterr ;N - undef 400460' 660 10 0 00 000010 tro h,fl%ope ;O - open errors repeat "S"-"P",< jrst opterr> ;P to R - undef 400461' 254 00 0 00 400541' 400462' 254 00 0 00 400541' 400463' 254 00 0 00 400541' 400464' 260 17 0 00 400473' pushj p,numbuf ;S - buffer size 400465' 254 00 0 00 400541' jrst opterr ;T - undef 400466' 660 10 0 00 000001 tro h,fl%lc ;U - lower to upper 000125 optmax=="U" 400467' 260 17 0 00 400506' optmod: pushj p,optdec ;parse a decimal number 400470' 242 02 0 00 000014 lsh b,^D12 ;shift it to mode position 400471' 434 10 0 00 000002 or h,b ;and or into flags 400472' 263 17 0 00 000000 popj p, 400473' 260 17 0 00 400506' numbuf: pushj p,optdec ;parse decimal 400474' 602 02 0 00 000777 trne b,777 ;any odd words? 400475' 271 02 0 00 001000 addi b,1000 ;yes - round up pages 400476' 242 02 0 00 777767 lsh b,^D-9 ;pages 400477' 242 02 0 00 000006 lsh b,6 ;shift into page count 400500' 434 10 0 00 000002 or h,b 400501' 263 17 0 00 000000 popj p, 400502' 260 17 0 00 400506' optbyt: pushj p,optdec ;parse a decimal number 400503' 242 02 0 00 000036 lsh b,^D30 ;shift it to the byte position 400504' 434 07 0 00 000002 or g,b ;and or into open bits 400505' 263 17 0 00 000000 popj p, 400506' 261 17 0 00 000003 optdec: push p,c 400507' 261 17 0 00 000004 push p,d 400510' 363 01 0 00 400536' sojle a,opterd ;count colon, better be an extra after that 400511' 134 02 0 00 000000 ildb b,t 400512' 302 02 0 00 000072 caie b,":" 400513' 254 00 0 00 400541' jrst opterr 400514' 400 03 0 00 000000 setz c, ;accumulate number in c 400515' 134 02 0 00 000000 optdcl: ildb b,t PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 4-3 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400516' 301 02 0 00 000060 cail b,"0" 400517' 303 02 0 00 000071 caile b,"9" 400520' 254 00 0 00 400536' jrst opterd 400521' 275 02 0 00 000060 subi b,"0" 400522' 221 03 0 00 000012 imuli c,^D10 400523' 270 03 0 00 000002 add c,b 400524' 363 01 0 00 400532' sojle a,optdcx ;count digit, if end of string, done 400525' 200 04 0 00 000000 move d,t ;peek at next 400526' 134 02 0 00 000004 ildb b,d 400527' 306 02 0 00 000057 cain b,"/" ;if /, this is end 400530' 254 00 0 00 400532' jrst optdcx 400531' 254 00 0 00 400515' jrst optdcl ;really get char 400532' 200 02 0 00 000003 optdcx: move b,c ;return value in b 400533' 262 17 0 00 000004 pop p,d 400534' 262 17 0 00 000003 pop p,c 400535' 263 17 0 00 000000 popj p, 400536' 262 17 0 00 000004 opterd: pop p,d 400537' 262 17 0 00 000003 pop p,c 400540' 262 17 0 17 000000 pop p,(p) 400541' 200 02 0 00 000001 opterr: move b,a ;save a 400542' 561 01 0 00 406620' hrroi a,[asciz / Error in option string/] 400543' 104 00 0 00 000313 esout 400544' 200 00 0 17 777774 move t,-4(p) ;-2 for saved args, -2 because called 2 deep 400545' 260 17 0 00 400041' pushj p,runer. 400546' 254 00 0 00 400437' jrst optend ;return from OPTION ifn oldcom,< 400547' 350 00 0 02 000002 opntty: aos fileol(b) ;always interactive 400550' 505 00 0 00 401220' hrli t,ttynt ;[13] copy special tty dispatch table 400551' 541 00 0 02 000016 hrri t,filr11(b) ;[13] since rest of open won't be done 400552' 251 00 0 02 000023 blt t,filr99(b) ;[13] 400553' 262 17 0 17 000000 pop p,(p) ;exit from caller 400554' 263 17 0 00 000000 popj p, > ;ifn oldcom PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5 PASIO MAC 7-Mar-81 20:52 low level routines for file openning ;AC usage for devprm ; b - fcb ; g - openf word ; h - used internally for dvchr flags ; t,a,c,h garbaged, g updated ;devprm sets up device-dependent parameters in the fcb, mainly ;byte size and I/O routines. 400555' 332 00 0 02 000003 devprm: skipe filerr(b) ;no-op if error already 400556' 263 17 0 00 000000 popj p, 400557' 200 10 0 00 000002 move h,b ;save fcb over dvchr call 400560' 550 01 0 02 000004 hrrz a,filjfn(b) 400561' 104 00 0 00 000117 dvchr 400562' 320 16 0 00 401315' erjmp doope ifn tenex, ;[7] save designator in case of tty 400563' 250 10 0 00 000002 exch h,b ;result of dvchr to h, fcb to b ;now we set up proper device/function dependent table 400564' 135 01 0 00 406625' ldb a,[fl%mod!filflg(b)];get user specified mode 400565' 307 01 0 00 000007 caig a,fm%lst ;unimplemented gets default 400566' 326 01 0 00 400605' jumpn a,devfnd ;if he gave one, use it 400567' 201 01 0 00 000001 movei a,fm%byt ;else, byte I/O is default 400570' 554 10 0 00 000010 hlrz h,h ;get dv%typ field 400571' 405 10 0 00 000777 andi h,(dv%typ) ;code from here to devfnd sets 400572' 306 10 0 00 000000 cain h,.dvdsk ; a to Pascal mode 400573' 201 01 0 00 000002 movei a,fm%map 400574' 306 10 0 00 000012 cain h,.dvtty 400575' 201 01 0 00 000003 movei a,fm%tty 400576' 306 10 0 00 000015 cain h,.dvnul 400577' 201 01 0 00 000004 movei a,fm%nul 400600' 306 10 0 00 000002 cain h,.dvmta 400601' 201 01 0 00 000000 ife tenex, ifn tenex, 400602' 302 10 0 00 000010 caie h,.dvcdr 400603' 306 10 0 00 000007 cain h,.dvlpt 400604' 201 01 0 00 000006 movei a,fm%chr 400605' devfnd: ifn tenex,< ;[7] if tty, see if ours cain a,fm%tty ;[7] tty mode? pushj p,devtty ;[7] yes, turn to fm%chr if not ctrl term adjstk p,-1 ;[7] a was saved > ;ifn tenex 400605' 205 00 0 00 070000 movsi t,070000 ;default byte size 400606' 335 00 0 02 000032 skipge filcnt(b) ;except for record I/O 400607' 205 00 0 00 440000 movsi t,440000 ;default is 36 400610' 607 07 0 00 770000 tlnn g,(of%bsz) ;if user defaulted it 400611' 434 07 0 00 000000 ior g,t ;then use our default ;special entry for mtaopn 400612' 275 01 0 00 000001 setdsp: subi a,1 ;now set dispatch vector per a 400613' 242 01 0 00 000001 lsh a,1 ;a _ (a - 1) * 2 400614' 335 00 0 02 000032 skipge filcnt(b) ;if record I/O, 400615' 271 01 0 00 000001 addi a,1 ;use second column in table 400616' 504 00 0 01 400624' hrl t,devtab(a) ;get address of disp. vec. from table PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-1 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400617' 541 00 0 02 000016 hrri t,filr11(b) ;whre to copy vector 400620' 251 00 0 02 000023 blt t,filr99(b) 400621' 263 17 0 00 000000 popj p, ifn tenex,< ;[7] ;this code is to see whether a tty is the controlling terminal. ; If so, we use pstin. Otherwise, you get the losing BBN type mode. devtty: push p,b hrroi a,[asciz /TTY/] ;get designator for own tty stdev jrst [adjstk p,-3 jrst doope] movei a,fm%tty ;assume ours came b,-2(p) ;compare with dev designator saved movei a,fm%byt ;not ours, use bin/bout pop p,b popj p, > ;ifn tenex [7] ^^ ;here is the table of dispatch vectors ;text, record 000000 fm%mta==0 ;pseudo-mode that sets defaults after looking at label type 400622' 000000 401177' exp mtatxt, mtarec 400623' 000000 401177' 400624' 000000 400642' devtab: exp byttxt, bytrec 400625' 000000 400663' 400626' 000000 400704' exp maptxt, maprec 400627' 000000 400725' 400630' 000000 400746' exp ttytxt, ttyrec 400631' 000000 400663' 400632' 000000 400767' exp nultxt, nulrec 400633' 000000 401010' 400634' 000000 401031' exp wrdtxt, wrdrec 400635' 000000 401052' 400636' 000000 401073' exp chrtxt, chrrec 400637' 000000 401114' 400640' 000000 401135' exp rectxt, recrec 400641' 000000 401156' ;here are the tables referred to in the matrix ; byte-size,getch,putch,getln,putln,close,dispatch ; getx,putx,putpage,setpos,curpos,init,open,break,lintst ; showln,fixln 400642' 000000 403746' byttxt: exp getchx,putchx,getlnx,putlnx,0,.+1 400643' 000000 403765' 400644' 000000 404301' 400645' 000000 404306' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-2 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400646' 000000 000000 400647' 000000 400650' 400650' 000000 405002' exp illfn,illfn,putpgx,setpbx,curpbx,cpopj,openfi,cpopj,cpopj 400651' 000000 405002' 400652' 000000 404314' 400653' 000000 404406' 400654' 000000 404400' 400655' 000000 400177' 400656' 000000 401303' 400657' 000000 400177' 400660' 000000 400177' 400661' 000000 401720' exp showln,notry 400662' 000000 401743' 400663' 000000 404322' bytrec: exp getbx,putbx,illfn,illfn,0,.+1 400664' 000000 404353' 400665' 000000 405002' 400666' 000000 405002' 400667' 000000 000000 400670' 000000 400671' 400671' 000000 404334' exp getxbx,putxbx,illfn,setpbx,curpbx,bxini,bxopn,cpopj,cpopj 400672' 000000 404367' 400673' 000000 405002' 400674' 000000 404406' 400675' 000000 404400' 400676' 000000 404417' 400677' 000000 404416' 400700' 000000 400177' 400701' 000000 400177' 400702' 000000 401720' exp showln,notry 400703' 000000 401743' 400704' 000000 402131' maptxt: exp getchd,putchd,getlnx,putlnx,dskclo,.+1 400705' 000000 402023' 400706' 000000 404301' 400707' 000000 404306' 400710' 000000 403616' 400711' 000000 400712' 400712' 000000 405002' exp illfn,illfn,putpgx,dskspo,dskcpo,dskbri,dskopn,dskbrk,dsklts 400713' 000000 405002' 400714' 000000 404314' 400715' 000000 403674' 400716' 000000 403743' 400717' 000000 403607' 400720' 000000 403417' 400721' 000000 403566' 400722' 000000 403561' 400723' 000000 401720' exp showln,notry 400724' 000000 401743' 400725' 000000 403333' maprec: exp getd,putd,illfn,illfn,dskclo,.+1 400726' 000000 403343' 400727' 000000 405002' 400730' 000000 405002' 400731' 000000 403616' 400732' 000000 400733' 400733' 000000 403353' exp getxd,putxd,illfn,dskspo,dskcpo,dskbri,dskopn,dskbrk,cpopj 400734' 000000 403365' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-3 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 400735' 000000 405002' 400736' 000000 403674' 400737' 000000 403743' 400740' 000000 403607' 400741' 000000 403417' 400742' 000000 403566' 400743' 000000 400177' 400744' 000000 401720' exp showln,notry 400745' 000000 401743' 400746' 000000 404126' ttytxt: exp getcht,putchx,getlnx,putlnx,0,.+1 400747' 000000 403765' 400750' 000000 404301' 400751' 000000 404306' 400752' 000000 000000 400753' 000000 400754' 400754' 000000 405002' exp illfn,illfn,putpgx,setpt,curpbx,ttyini,tdvopn,cpopj,cpopj 400755' 000000 405002' 400756' 000000 404314' 400757' 000000 404172' 400760' 000000 404400' 400761' 000000 404124' 400762' 000000 404135' 400763' 000000 400177' 400764' 000000 400177' 400765' 000000 404236' exp tdvshl,tdvfxl 400766' 000000 404275' 400663' ttyrec==bytrec ;not sure this is right. What is record I/O on tty? 400767' 000000 402135' nultxt: exp simeof,cpopj,simeof,cpopj,0,.+1 400770' 000000 400177' 400771' 000000 402135' 400772' 000000 400177' 400773' 000000 000000 400774' 000000 400775' 400775' 000000 405002' exp illfn,illfn,cpopj,nulspo,retzer,cpopj,openfi,cpopj,cpopj 400776' 000000 405002' 400777' 000000 400177' 401000' 000000 401550' 401001' 000000 401546' 401002' 000000 400177' 401003' 000000 401303' 401004' 000000 400177' 401005' 000000 400177' 401006' 000000 401720' exp showln,notry 401007' 000000 401743' 401010' 000000 402135' nulrec: exp simeof,cpopj,illfn,illfn,0,.+1 401011' 000000 400177' 401012' 000000 405002' 401013' 000000 405002' 401014' 000000 000000 401015' 000000 401016' 401016' 000000 402135' exp simeof,cpopj,illfn,nulspo,retzer,cpopj,openfi,cpopj,cpopj 401017' 000000 400177' 401020' 000000 405002' 401021' 000000 401550' 401022' 000000 401546' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-4 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 401023' 000000 400177' 401024' 000000 401303' 401025' 000000 400177' 401026' 000000 400177' 401027' 000000 401720' exp showln,notry 401030' 000000 401743' 401031' 000000 405526' wrdtxt: exp getchb,putchb,getlnx,putlnx,logclo,.+1 401032' 000000 405521' 401033' 000000 404301' 401034' 000000 404306' 401035' 000000 405740' 401036' 000000 401037' 401037' 000000 405002' exp illfn,illfn,putpgx,illfn,illfn,logini,wrdopn,logclo,wrdlts 401040' 000000 405002' 401041' 000000 404314' 401042' 000000 405002' 401043' 000000 405002' 401044' 000000 406005' 401045' 000000 405727' 401046' 000000 405740' 401047' 000000 403561' 401050' 000000 401720' exp showln,notry 401051' 000000 401743' 401052' 000000 406014' wrdrec: exp getb,putb,illfn,illfn,logclo,.+1 401053' 000000 406024' 401054' 000000 405002' 401055' 000000 405002' 401056' 000000 405740' 401057' 000000 401060' 401060' 000000 406034' exp getxb,illfn,illfn,illfn,illfn,logini,wrdopn,logclo,cpopj 401061' 000000 405002' 401062' 000000 405002' 401063' 000000 405002' 401064' 000000 405002' 401065' 000000 406005' 401066' 000000 405727' 401067' 000000 405740' 401070' 000000 400177' 401071' 000000 401720' exp showln,notry 401072' 000000 401743' 401073' 000000 405526' chrtxt: exp getchb,putchb,getlnx,putlnx,logclo,.+1 401074' 000000 405521' 401075' 000000 404301' 401076' 000000 404306' 401077' 000000 405740' 401100' 000000 401101' 401101' 000000 405002' exp illfn,illfn,putpgx,setpb,curpbx,logini,chropn,logclo,cpopj 401102' 000000 405002' 401103' 000000 404314' 401104' 000000 406002' 401105' 000000 404400' 401106' 000000 406005' 401107' 000000 405716' 401110' 000000 405740' 401111' 000000 400177' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-5 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 401112' 000000 401720' exp showln,notry 401113' 000000 401743' 401114' 000000 406014' chrrec: exp getb,putb,illfn,illfn,logclo,.+1 401115' 000000 406024' 401116' 000000 405002' 401117' 000000 405002' 401120' 000000 405740' 401121' 000000 401122' 401122' 000000 406034' exp getxb,illfn,illfn,setpb,curpbx,logini,chropn,logclo,cpopj 401123' 000000 405002' 401124' 000000 405002' 401125' 000000 406002' 401126' 000000 404400' 401127' 000000 406005' 401130' 000000 405716' 401131' 000000 405740' 401132' 000000 400177' 401133' 000000 401720' exp showln,notry 401134' 000000 401743' 401135' 000000 404466' rectxt: exp getcx,putcx,getlx,putlx,logclx,.+1 401136' 000000 404456' 401137' 000000 404537' 401140' 000000 404506' 401141' 000000 404666' 401142' 000000 401143' 401143' 000000 405002' exp illfn,illfn,putpgx,illfn,illfn,loginx,chropx,logclx,cpopj 401144' 000000 405002' 401145' 000000 404314' 401146' 000000 405002' 401147' 000000 405002' 401150' 000000 404674' 401151' 000000 404557' 401152' 000000 404666' 401153' 000000 400177' 401154' 000000 401720' exp showln,notry 401155' 000000 401743' 401156' 000000 404421' recrec: exp getbxr,putbxr,illfn,illfn,0,.+1 401157' 000000 404436' 401160' 000000 405002' 401161' 000000 405002' 401162' 000000 000000 401163' 000000 401164' 401164' 000000 405002' exp illfn,illfn,illfn,setpbx,curpbx,bxini,bxopn,cpopj,cpopj 401165' 000000 405002' 401166' 000000 405002' 401167' 000000 404406' 401170' 000000 404400' 401171' 000000 404417' 401172' 000000 404416' 401173' 000000 400177' 401174' 000000 400177' 401175' 000000 401720' exp showln,notry 401176' 000000 401743' 401177' mtarec: 401177' 000000 405252' mtatxt: exp notop,notop,notop,notop,0,.+1 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-6 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 401200' 000000 405252' 401201' 000000 405252' 401202' 000000 405252' 401203' 000000 000000 401204' 000000 401205' 401205' 000000 405252' exp notop,notop,notop,notop,notop,cpopj,mtaopn,cpopj,cpopj 401206' 000000 405252' 401207' 000000 405252' 401210' 000000 405252' 401211' 000000 405252' 401212' 000000 400177' 401213' 000000 404703' 401214' 000000 400177' 401215' 000000 400177' 401216' 000000 405252' exp notop,notop 401217' 000000 405252' ;The following table is used for tty and ttyout. It is set up by pasin. 401220' 000000 404000' ttynt: exp gettty,puttty,getlnx,putlnx,0,.+1 401221' 000000 404117' 401222' 000000 404301' 401223' 000000 404306' 401224' 000000 000000 401225' 000000 401226' 401226' 000000 405002' exp illfn,illfn,putpgx,illfn,illfn,ttyini,cpopj,cpopj,cpopj 401227' 000000 405002' 401230' 000000 404314' 401231' 000000 405002' 401232' 000000 405002' 401233' 000000 404124' 401234' 000000 400177' 401235' 000000 400177' 401236' 000000 400177' 401237' 000000 404055' exp ttyshl,ttyfxl 401240' 000000 404110' ;The following table is used after an error 401241' 000000 400177' erropt: exp cpopj,cpopj,cpopj,cpopj,0,.+1 401242' 000000 400177' 401243' 000000 400177' 401244' 000000 400177' 401245' 000000 000000 401246' 000000 401247' 401247' 000000 400177' exp cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj 401250' 000000 400177' 401251' 000000 400177' 401252' 000000 400177' 401253' 000000 400177' 401254' 000000 400177' 401255' 000000 400177' 401256' 000000 400177' 401257' 000000 400177' 401260' 000000 400177' exp cpopj,notry PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 5-7 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 401261' 000000 401743' ;The following is used for unopened files: 401262' unop.: 401262' 000000 405252' unop: exp notop,notop,notop,notop,0,.+1 401263' 000000 405252' 401264' 000000 405252' 401265' 000000 405252' 401266' 000000 000000 401267' 000000 401270' 401270' 000000 405252' exp notop,notop,notop,notop,notop,cpopj,cpopj,cpopj,cpopj 401271' 000000 405252' 401272' 000000 405252' 401273' 000000 405252' 401274' 000000 405252' 401275' 000000 400177' 401276' 000000 400177' 401277' 000000 400177' 401300' 000000 400177' 401301' 000000 405252' exp notop,notop 401302' 000000 405252' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 6 PASIO MAC 7-Mar-81 20:52 low level routines for file openning ; Openfi is called by the device-dependent openner, f%open. ; For simple devices, f%open can simply point to openfi. ;openfi just does an openf - pretty straight-forward ; b - fcb, must be saved and restored ; g - openf word ; garbages a,h 401303' 332 00 0 02 000003 openfi: skipe filerr(b) ;no-op if error already seen 401304' 263 17 0 00 000000 popj p, 401305' 200 10 0 00 000002 move h,b ;save fcb pointer 401306' 550 01 0 10 000004 hrrz a,filjfn(h) ;set up args for openf - jfn 401307' 200 02 0 00 000007 move b,g ;openf word 401310' 104 00 0 00 000021 openf 401311' 320 16 0 00 401315' erjrst doope ;[5] 401312' 200 02 0 00 000010 move b,h ;restore fcb 401313' 263 17 0 00 000000 popj p, 401314' 200 10 0 00 000002 oper: move h,b ;error in openfi 401315' 201 01 0 00 400000 doope: movei a,400000 ;current process 401316' 104 00 0 00 000012 geter 401317' 550 01 0 00 000002 hrrz a,b ;error in RH only 401320' 200 02 0 00 000010 smoper: move b,h ;restore fcb - entry if error is known 401321' 202 01 0 02 000003 movem a,filerr(b) ;save error for user 401322' 200 01 0 02 000007 move a,filbad(b) ;set bad fileof 401323' 202 01 0 02 000001 movem a,fileof(b) 401324' 202 01 0 02 000002 movem a,fileol(b) 401325' 505 00 0 00 401241' hrli t,erropt ;and set up to get error if we try more I/O 401326' 541 00 0 02 000016 hrri t,filr11(b) 401327' 251 00 0 02 000023 blt t,filr99(b) 401330' 200 00 0 02 000006 move t,filflg(b) 401331' 263 17 0 00 000000 popj p, ;caller will process error later 401332' 336 00 0 02 000003 errchk: skipn filerr(b) ;error? 401333' 254 00 0 00 401355' jrst erchOK ;no 401334' 200 00 0 02 000006 move t,filflg(b) ;yes - is he enabled? 401335' 602 00 0 00 000010 trne t,fl%ope 401336' 254 00 0 00 401355' jrst erchOK ;yes - then that's OK, too ;here if an error we are supposed to handle 401337' 200 04 0 00 000002 move d,b ; 401340' 260 17 0 00 405107' pushj p,erp ;print error message 401341' 200 02 0 00 000004 move b,d 401342' 561 01 0 00 406626' hrroi a,[asciz /Try another file spec: /] 401343' 104 00 0 00 000076 psout 401344' 574 01 0 02 000032 hlre a,filcnt(b) ;restore state, without filespec 401345' 210 01 0 00 000001 movn a,a ;a has size of component, 0 if text 401346' 402 03 0 00 000004 setzm c,d ;no filespec 401347' 661 03 0 00 400000 tlo c,(op%tty) ;but ask for it from tty 401350' 200 06 0 02 000037 move f,filsvf(b) 401351' 661 06 0 00 020000 tlo f,(gj%cfm) ;confirm it from tty 401352' 200 07 0 02 000030 move g,filsvg(b) 401353' 200 10 0 02 000006 move h,filflg(b) 401354' 263 17 0 00 000000 popj p, ;error return ;here for no error or one we don't care about 401355' 350 00 0 17 000000 erchOK: aos (p) PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 6-1 PASIO MAC 7-Mar-81 20:52 low level routines for file openning 401356' 263 17 0 00 000000 popj p, ;OK - skip return PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 7 PASIO MAC 7-Mar-81 20:52 low level routines for file openning ;getjfn - AC usage ; b - fcb pointer - must be saved and restored ; c - string ; d - string length ; f - gtjfn word ; h - used to save p or h ; klobbers t,a,c,d,h ;getjfn gets a jfn if necessary. In case of ; error, it sets of filerr, so the user better check! 401357' 332 00 0 02 000003 getjfn: skipe filerr(b) ;should be a no-op if previous error 401360' 263 17 0 00 000000 popj p, 401361' 603 03 0 00 200000 tlne c,(op%wld) ;set up for wild cards if requested 401362' 661 06 0 00 000100 tlo f,(gj%ifg) 401363' 603 03 0 00 400000 tlne c,(op%tty) ;if user asked for spec from tty, get it 401364' 254 00 0 00 401502' jrst ttyspc 401365' 326 04 0 00 401431' jumpn d,havspc ;if ascii spec, use it 401366' 332 00 0 02 000004 skipe filjfn(b) ;otherwise, if jfn already exists, use it 401367' 263 17 0 00 000000 popj p, ;here if no spec and no existing jfn - this is an internal file, we have ;to gensym a name. Also, we set fl%tmp so it gets deleted upon exit of ;the lexical scope in which it was created. ;The name we make is of the form PAS-INTERNAL.001234;T where 1234 is ;the address of the FCB in octal (for debugging) 401370' 201 00 0 00 000040 movei t,fl%tmp ;set temp flag 401371' 436 00 0 02 000006 iorm t,filflg(b) 401372' 200 10 0 00 000017 move h,p ;h _ saved copy of p 401373' 541 17 0 17 000006 hrri p,6(p) ;advance stack to get space for new name 401374' 541 04 0 10 000001 hrri d,1(h) ;place for new spec 401375' 505 04 0 00 406633' hrli d,[ascii /PAS-INTERNAL./] 401376' 251 04 0 10 000003 blt d,3(h) ;put it there 401377' 200 04 0 00 406636' move d,[point 7,3(h),20] ;place to put the rest 401400' 514 01 0 00 000002 hrlz a,b ;use addr of FCB, in octal 401401' 201 03 0 00 000006 movei c,6 ;6 digits 401402' 400 00 0 00 000000 setz t, 401403' 246 00 0 00 000003 makspl: lshc t,3 ;shift t and a - bytes in t 401404' 271 00 0 00 000060 addi t,"0" ;convert to char 401405' 136 00 0 00 000004 idpb t,d ;and put in destin 401406' 400 00 0 00 000000 setz t, 401407' 367 03 0 00 401403' sojg c,makspl ;loop for 6 char's 401410' 201 00 0 00 000073 movei t,";" ;now put ;T 401411' 136 00 0 00 000004 idpb t,d 401412' 201 00 0 00 000124 movei t,"T" 401413' 136 00 0 00 000004 idpb t,d 401414' 400 00 0 00 000000 setz t, 401415' 136 00 0 00 000004 idpb t,d 401416' 200 00 0 00 000002 move t,b ;where makspx expects B to be saved 401417' 200 01 0 00 000006 makspr: move a,f ;a _ flags 401420' 561 02 0 10 000001 hrroi b,1(h) ;b _ ptr to stack copy 401421' 104 00 0 00 000020 gtjfn 401422' 320 16 0 00 401424' erjrst makspe ;[5] 401423' 254 00 0 00 401451' jrst makspx ;finished making spec ;If this is an internal file, we want to be able to read or update it ;even if it doesn't exist. So, if the OLD bit is on, we will clear it PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 7-1 PASIO MAC 7-Mar-81 20:52 low level routines for file openning ;(and set the WRITE bit for openf), and try again. If that doesn't ;help, there is something more serious wrong. 401424' 607 06 0 00 100000 makspe: tlnn f,(gj%old) ;did he ask for old file? 401425' 254 00 0 00 401455' jrst specer ;no - nothing we can do 401426' 621 06 0 00 100000 tlz f,(gj%old) ;yes - enable for writing 401427' 660 07 0 00 100000 tro g,of%wr ;also openf bits 401430' 254 00 0 00 401417' jrst makspr ;retry this way ;here if the user gave us a spec. 401431' 201 00 0 00 000040 havspc: movei t,fl%tmp ;[37] a new file spec - clear temp from old one 401432' 412 00 0 02 000006 andcam t,filflg(b) 401433' 200 00 0 00 000002 move t,b ;t _ saved copy of b ifn klcpu,< ;[5] 401434' 505 01 0 00 440700 hrli a,440700 ;a _ ptr to start of copy in stack 401435' 541 01 0 17 000001 hrri a,1(p) 401436' 133 04 0 00 000001 adjbp d,a ;d _ ptr to last byte stack copy > ;[5] ifn klcpu ife klcpu,< ;[5] start hrri a,1(p) ;RH(a) _ point to start on stack push p,e idivi d,5 ;d _ words, e _ bytes addi d,(a) ;RH(d) _ addr of last byte hll d,byttab(e) ;LH(d) _ pointer to last byte pop p,e > ;[5] end ife klcpu 401437' 200 10 0 00 000017 move h,p ;h _ saved copy of p 401440' 541 17 0 04 000001 hrri p,1(d) ;advance stack to cover whole copy 401441' 504 01 0 00 000003 hrl a,c ;a _ blt from original to stack 401442' 251 01 0 04 000001 blt a,1(d) 401443' 400 01 0 00 000000 setz a, ;make asciz by putting null at end 401444' 136 01 0 00 000004 idpb a,d 401445' 200 01 0 00 000006 move a,f ;a _ flags 401446' 561 02 0 10 000001 hrroi b,1(h) ;b _ ptr to stack copy 401447' 104 00 0 00 000020 gtjfn 401450' 320 16 0 00 401455' erjrst specer ;[5] 401451' 200 02 0 00 000000 makspx: move b,t ;restore ac's 401452' 200 17 0 00 000010 move p,h 401453' 202 01 0 02 000004 movem a,filjfn(b) ;return new jfn 401454' 263 17 0 00 000000 popj p, ifn tenex,< ;[5] byttab: point 7,0 ;[5] point 7,0,6 ;[5] point 7,0,13 ;[5] point 7,0,20 ;[5] point 7,0,27 ;[5] > ;[5] ifn tenex 401455' 200 01 0 00 000000 specer: move a,t ;get error recovery flag 401456' 200 01 0 01 000006 move a,filflg(a) 401457' 602 01 0 00 000010 trne a,fl%ope ;if he wants to handle errors, jrst [move b,t ;let him - first restore AC's move p,h 401460' 254 00 0 00 406637' jrst oper] ;special error printer needed for this routine, because main one PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 7-2 PASIO MAC 7-Mar-81 20:52 low level routines for file openning ;uses jfns, but we don't have a file spec yet ;note that we are still in a funny context, where p and b are odd 401461' 201 01 0 00 406642' movei a,[asciz / /] 401462' 104 00 0 00 000313 esout 401463' 201 01 0 00 000101 movei a,.priou 401464' 525 02 0 00 400000 hrloi b,400000 401465' 400 03 0 00 000000 setz c, 401466' 104 00 0 00 000011 erstr 401467' 255 00 0 00 000000 jfcl 401470' 255 00 0 00 000000 jfcl 401471' 561 01 0 00 406643' hrroi a,[asciz / - /] 401472' 104 00 0 00 000076 psout 401473' 561 01 0 10 000001 hrroi a,1(h) ;file spec the user gave 401474' 104 00 0 00 000076 psout hrroi a,[asciz / 401475' 561 01 0 00 406644' Try another file spec: /] 401476' 104 00 0 00 000076 psout 401477' 200 02 0 00 000000 move b,t ;restore to standard AC's 401500' 200 17 0 00 000010 move p,h 401501' 661 06 0 00 020000 tlo f,(gj%cfm) ;confirm spec from tty ;jrst ttyspc ;and get spec from tty 401502' 200 10 0 00 000002 ttyspc: move h,b ;h _ saved copy of b 401503' 201 01 0 00 000040 movei a,fl%tmp ;clear temp flag, as this is new spec 401504' 412 01 0 02 000006 andcam a,filflg(b) 401505' 200 01 0 00 000006 ttyspl: move a,f ;a _ flags 401506' 661 01 0 00 000002 tlo a,(gj%fns) 401507' 200 02 0 00 406652' move b,[xwd .priin,.priou] 401510' 104 00 0 00 000020 gtjfn 401511' 320 16 0 00 401515' erjrst ttyspe ;[5] 401512' 200 02 0 00 000010 move b,h 401513' 202 01 0 02 000004 movem a,filjfn(b) ;return new jfn 401514' 263 17 0 00 000000 popj p, 401515' 201 01 0 00 406642' ttyspe: movei a,[asciz / /] 401516' 104 00 0 00 000313 esout 401517' 201 01 0 00 000101 movei a,.priou 401520' 525 02 0 00 400000 hrloi b,400000 401521' 400 03 0 00 000000 setz c, 401522' 104 00 0 00 000011 erstr 401523' 255 00 0 00 000000 jfcl 401524' 255 00 0 00 000000 jfcl hrroi a,[asciz / 401525' 561 01 0 00 406644' Try another file spec: /] 401526' 104 00 0 00 000076 psout 401527' 254 00 0 00 401505' jrst ttyspl PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 8 PASIO MAC 7-Mar-81 20:52 global entries to I/O routines subttl global entries to I/O routines ;In order to use the routines in PASNUM, get and put must obey the ;following AC usage conventions: ; t,a - temps ; b up - must be preserved 401530' 254 00 1 02 000016 get.: jrst @filget(b) ;get is odd because it is also a jsys 401530' getch==get. 401531' 254 00 1 02 000017 put: jrst @filput(b) 401531' putch==put 401532' 254 00 1 02 000020 getln: jrst @filgln(b) 401533' 254 00 1 02 000021 putln: jrst @filpln(b) 401534' 200 01 0 02 000023 putpg: vcall f%putp 401535' 254 00 1 01 000002 401536' 200 01 0 02 000023 setpos: vcall f%setp 401537' 254 00 1 01 000003 401540' 200 01 0 02 000023 curpos: vcall f%curp 401541' 254 00 1 01 000004 401542' 200 01 0 02 000023 getx.: vcall f%getx 401543' 254 00 1 01 000000 401544' 200 01 0 02 000023 putx: vcall f%putx 401545' 254 00 1 01 000001 401546' 402 00 0 17 000001 retzer: setzm 1(p) ;returns zero - used for device nul 401547' 263 17 0 00 000000 popj p, ;setpos for nul:. no-op, except in read mode if GET not suppressed, ;it simulates EOF. 401550' 326 04 0 00 401552' nulspo: jumpn d,nulspx ;if get suppression, no-op 401551' 336 00 0 02 000007 skprea ;if write mode, no-op 401552' 263 17 0 00 000000 nulspx: popj p, ;no-op 401553' 254 00 0 00 402135' jrst simeof ;else simulate GET 401554' 205 03 0 00 404000 resdev: movsi c,(cz%abt!co%nrj) ;this is DISMISS - the tops10 resdv. 401555' 254 00 0 00 401560' jrst clochk 401556' 625 03 0 00 400000 relf.: tlza c,(co%nrj) ;this is RCLOSE - release the jfn 401557' 661 03 0 00 400000 clofil: tlo c,(co%nrj) ;this is CLOSE - keep the jfn 401560' 200 01 0 02 000040 clochk: move a,filtst(b) ;if the file isn't init'ed 401561' 302 01 0 00 314157 caie a,314157 401562' 260 17 0 00 405414' pushj p,initb. ;then do it 401563' doclos: ;We now assume that if there is a non-zero jfn, that is a ;valid jfn. SETPRM is thus coded to defend against garbage ;jfn's. But if a user calls this, he should beware. ;warning: only a and t are free. Be sure the filclo routine knows that ;c - close bits 401563' 201 01 0 00 000000 movei a,0 ;do mode-dependent clean-up 401564' 250 01 0 02 000022 exch a,filclo(b) 401565' 332 00 0 00 000001 skipe a ; if 0, no routine 401566' 260 17 0 01 000000 pushj p,(a) 401567' 200 00 0 02 000004 move t,filjfn(b) ;close file 401570' 322 00 0 00 401624' jumpe t,clofb ;if no jfn, nothing to close ;if we are killing the jfn, special cleanups may be needed 401571' 603 03 0 00 400000 tlne c,(co%nrj) ;if asked to kill the jfn, do so PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 8-1 PASIO MAC 7-Mar-81 20:52 global entries to I/O routines 401572' 254 00 0 00 401610' jrst clonk ;don't kill jfn ;beginning of special cleanups for releasing jfn 401573' 402 00 0 02 000004 setzm filjfn(b) ;clear all record of it 401574' 200 01 0 02 000006 move a,filflg(b) ;get flags 401575' 606 01 0 00 000040 trnn a,fl%tmp ;if temp file 401576' 254 00 0 00 401610' jrst clonk ; not temp, done with it ;Now, all cases go either to the following code for temp files, ;or to clonk, for closing without killing. ;temp file - releasing implies deleting 401577' 550 01 0 00 000000 hrrz a,t ;delete instead of just closing 401600' 505 01 0 00 400000 hrli a,(co%nrj) ;first we must close it 401601' 104 00 0 00 000022 closf 401602' 320 17 0 00 405006' chkquo 401603' 320 16 0 00 401621' erjrst clorl ;couldn't close it - just release it 401604' 505 01 0 00 200000 hrli a,(df%exp) ;now delete, expunge, and release it 401605' 104 00 0 00 000026 delf 401606' 320 16 0 00 401621' erjrst clorl ;couldn't - just release it 401607' 254 00 0 00 401624' jrst clofb ;done with this jfn ;normal file - close it without killing it, using bits from c 401610' 550 01 0 00 000000 clonk: hrrz a,t 401611' 500 01 0 00 000003 hll a,c 401612' 104 00 0 00 000022 closf 401613' 320 17 0 00 405006' chkquo ;[27] 401614' 320 16 0 00 401616' erjrst .+2 ;[7] close failed, release instead 401615' 254 00 0 00 401624' jrst clofb ; close worked, go on 401616' 603 03 0 00 400000 tlne c,(co%nrj) ;don't release if asked not to! 401617' 254 00 0 00 401624' jrst clofb 401620' 550 01 0 00 000000 hrrz a,t 401621' 104 00 0 00 000023 clorl: rljfn 401622' 320 17 0 00 405006' chkquo ;[27] 401623' 320 16 0 00 401624' erjrst clofb ;[7] release failed too, no hope ;All cases join here, even after "impossible" combinations of errors 401624' 201 01 0 00 000000 clofb: movei a,0 ;clean up buffers if any 401625' 250 01 0 02 000015 exch a,filbuf(b) 401626' 322 01 0 00 401644' jumpe a,clof2 ; none- done 401627' 261 17 0 00 000002 push p,b ;demap the page 401630' 261 17 0 00 000001 push p,a ; since may have been doing pmap I/O on it ife tenex,< 401631' 554 03 0 00 000001 hlrz c,a ;count in rh of c 401632' 135 02 0 00 406653' ldb b,[point 9,a,26] ;page no. 401633' 505 02 0 00 400000 hrli b,400000 ;in this process 401634' 474 01 0 00 000000 seto a, ;clear the page 401635' 505 03 0 00 400000 hrli c,(pm%cnt) ;do all at once 401636' 104 00 0 00 000056 pmap 401637' 320 17 0 00 405006' chkquo ;[27] 401640' 320 16 0 00 401641' erjmp .+1 ;no errors here, please > ;ife tenex ifn tenex,< hlrz t,a ;count of pages to be released ldb b,[point 9,a,26] ;page no. hrli b,400000 ;in this process seto a, ;clear the page setz c, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 8-2 PASIO MAC 7-Mar-81 20:52 global entries to I/O routines clof1l: pmap addi b,1 ;next page sojg t,clof1l ;if any > ;ifn tenex 401641' 262 17 0 00 000001 pop p,a ;restore target page 401642' 260 17 0 00 406422' pushj p,relpg. ;put it in free list 401643' 262 17 0 00 000002 pop p,b 401644' 505 00 0 00 401262' clof2: hrli t,unop ;[12] now mark file as no longer open 401645' 541 00 0 02 000016 hrri t,filr11(b) ;[12] so future accesses get error 401646' 251 00 0 02 000023 blt t,filr99(b) ;[12] 401647' 263 17 0 00 000000 popj p, 401650' 200 01 0 02 000023 break: vcall f%brk ;force out buffers 401651' 254 00 1 01 000007 401652' 261 17 0 00 000003 breaki: push p,c 401653' 261 17 0 00 000002 push p,b 401654' 200 01 0 00 406617' move a,[ascii /-----/] ;old line no. no longer valid 401655' 202 01 0 02 000031 movem a,fillnr(b) 401656' 200 01 0 02 000023 pcall f%init ;use buffer filler if any 401657' 260 17 1 01 000005 401660' 262 17 0 00 000002 pop p,b 401661' 262 17 0 00 000004 pop p,d 401662' 574 03 0 02 000032 hlre c,filcnt(b) ;make up argument for binary get 401663' 210 03 0 00 000003 movn c,c ;is negative count in filcnt 401664' 332 00 0 02 000007 skpwrt ;don't do get if write-only file! 401665' 322 04 1 02 000016 jumpe d,@filget(b) ;and get unless suppressed 401666' 200 01 0 02 000032 move a,filcnt(b) ;otherwise clear buffer 401667' 402 00 0 01 000000 setzm (a) 401670' 253 01 0 00 401667' aobjn a,.-1 401671' 200 01 0 02 000007 move a,filbad(b) ;and set eoln, since dummy data in buf 401672' 202 01 0 02 000002 movem a,fileol(b) 401673' 263 17 0 00 000000 popj p, 401674' 205 03 0 00 400000 nextfi: movsi c,(co%nrj) ;go to next wildcard file - must be closed 401675' 260 17 0 00 401563' pushj p,doclos 401676' 200 01 0 02 000004 move a,filjfn(b) 401677' 104 00 0 00 000017 gnjfn 401700' 254 00 0 00 401703' jrst nonext 401701' 202 01 0 17 000001 movem a,1(p) ;if succeed, return flags (always nonzero) 401702' 263 17 0 00 000000 popj p, 401703' 200 04 0 00 000002 nonext: move d,b 401704' 201 01 0 00 400000 movei a,400000 ;nextfi failed, see why 401705' 104 00 0 00 000012 geter 401706' 405 02 0 00 777777 andi b,-1 ;get error code only 401707' 302 02 0 00 601054 caie b,gnjfx1 ;if anything except ran out of files 401710' 254 00 0 00 401715' jrst nonxt1 ;it is a real error 401711' 200 02 0 00 000004 move b,d 401712' 402 00 0 17 000001 setzm 1(p) ;bad return 401713' 402 00 0 02 000004 setzm filjfn(b) ;they released our jfn (naughty folks) 401714' 263 17 0 00 000000 popj p, 401715' 260 17 0 00 405064' nonxt1: pushj p,ioer ;a real error 401716' 402 00 0 17 000001 setzm 1(p) ;still give bad return 401717' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 9 PASIO MAC 7-Mar-81 20:52 device-independent routines for error recovery subttl device-independent routines for error recovery ;showln - this is the default showln for devices where we can't ; really show the current line. 401720' 261 17 0 00 000001 showln: push p,a 401721' 261 17 0 00 000003 push p,c 401722' 261 17 0 00 000004 push p,d 401723' 561 01 0 00 406654' hrroi a,[asciz /[Error at character number /] 401724' 104 00 0 00 000076 psout 401725' 260 17 0 00 401540' pushj p,curpos ;get current position 401726' 261 17 0 00 000002 push p,b 401727' 201 01 0 00 000101 movei a,.priou 401730' 200 02 0 17 000001 move b,1(p) ;returned value 401731' 201 03 0 00 000012 movei c,12 ;in decimal 401732' 104 00 0 00 000224 nout 401733' 255 00 0 00 000000 jfcl hrroi a,[asciz /] 401734' 561 01 0 00 406530' /] 401735' 104 00 0 00 000076 psout 401736' 262 17 0 00 000002 pop p,b 401737' 262 17 0 00 000004 pop p,d 401740' 262 17 0 00 000003 pop p,c 401741' 262 17 0 00 000001 pop p,a 401742' 263 17 0 00 000000 popj p, ;notry - use this routine for FIXLIN with devices where you don't ; implement retrying. 401743' 561 01 0 00 406662' notry: hrroi a,[asciz /Call to READ/] 401744' 104 00 0 00 000076 psout 401745' 260 17 0 00 400041' pushj p,runer. hrroi a,[asciz / [Skipping bad character] 401746' 561 01 0 00 406665' /] 401747' 104 00 0 00 000076 psout 401750' 254 00 1 02 000016 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 - jfn for printing; B - FCB 401751' 261 17 0 00 000000 tryagn: push p,t 401752' 261 17 0 00 000001 push p,a 401753' 261 17 0 00 000002 push p,b 401754' 261 17 0 00 000003 push p,c 401755' tryag1: ;Now, if DDT is there, do a bit differently 401755' 332 00 0 00 400060* skipe .jbddt ;.jbddt? 401756' 254 00 0 00 401766' jrst tryddt ;yes - that is fine 401757' 200 01 0 00 406507' move a,[xwd 400000,770] ;else look for VMDDT 401760' 104 00 0 00 000057 rpacs ;page exist? 401761' 200 01 0 17 777776 move a,-2(p) 401762' 607 02 0 00 010000 tlnn b,(pa%pex) ; 401763' 254 00 0 00 402010' jrst trynod ;no - continue 401764' 607 02 0 00 020000 tlnn b,(pa%ex) ;allowed to execute? 401765' 254 00 0 00 402010' jrst trynod ;no - continue ;Here if DDT - give him an option PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 9-1 PASIO MAC 7-Mar-81 20:52 device-independent routines for error recovery 401766' 200 01 0 17 777776 tryddt: move a,-2(p) hrroi b,[asciz / [Try again, from the beginning of the bad number.] [Or type D to enter the debugger.] 401767' 561 02 0 00 406673' /] 401770' 400 03 0 00 000000 setz c, 401771' 104 00 0 00 000053 sout 401772' 200 02 0 17 777777 move b,-1(p) ;get back FCB 401773' 260 17 1 02 000016 pushj p,@filget(b) 401774' 200 01 0 02 000043 move a,filcmp(b) ;See if he typed a D 401775' 302 01 0 00 000104 caie a,"D" 401776' 306 01 0 00 000144 cain a,"d" 401777' 304 00 0 00 000000 caia 402000' 254 00 0 00 402016' jrst tryOK ;no a D - use what he gave us ;Here if he wants DDT - let runer. do it 402001' 200 00 0 17 777775 move t,-3(p) ;PC passed to us in T 402002' 561 01 0 00 406716' hrroi a,[asciz /Call to READ /] 402003' 104 00 0 00 000076 psout 402004' 260 17 0 00 400041' pushj p,runer. 402005' 200 01 0 02 000023 pcall f%init ;clear input buffer again 402006' 260 17 1 01 000005 402007' 254 00 0 00 401755' jrst tryag1 ;Here for no DDT cases 402010' 200 01 0 17 777776 trynod: move a,-2(p) hrroi b,[asciz / [Try again, from the beginning of the bad number.] 402011' 561 02 0 00 406721' /] 402012' 400 03 0 00 000000 setz c, 402013' 104 00 0 00 000053 sout 402014' 200 02 0 17 777777 move b,-1(p) 402015' 260 17 1 02 000016 pushj p,@filget(b) ;just get a char 402016' 262 17 0 00 000003 tryOK: pop p,c 402017' 262 17 0 00 000002 pop p,b ;return it to the user 402020' 262 17 0 00 000001 pop p,a 402021' 262 17 0 00 000000 pop p,t 402022' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines subttl pmap I/O - ascii top-level routines 000011 filadv==fils11 ;routine to get to next buffer 000033 filpag==filst1 ;disk page currently working on 000036 filbgp==filst4 ;disk page at beginning of buffer 000024 filpgb==fils15 ;number of pages in buffer 000034 filbct==filst2 ;bytes in current page 000035 filbpt==filst3 ;pointer to next byte in buffer 000012 fillby==fils12 ;last byte in file 000013 filcby==fils13 ;current byte in file 000025 filbfp==fils16 ;ptr to beginning of current page 000026 filbfs==fils17 ;size of page in bytes 000027 fillct==fils20 ;count of last record operation ;put 402023' 350 01 0 02 000013 putchd: aos a,filcby(b) ;advance current byte 402024' 313 01 0 02 000012 camle a,fillby(b) ;beyond end seen so far? 402025' 202 01 0 02 000012 movem a,fillby(b) ;yes - update it 402026' 375 00 0 02 000034 sosge filbct(b) ;room in buffer? 402027' 260 17 1 02 000011 pushj p,@filadv(b) ;no - next 402030' 200 01 0 02 000043 move a,filcmp(b) ;put it in 402031' 136 01 0 02 000035 idpb a,filbpt(b) 402032' 320 17 0 00 402040' ercal maperr 402033' 263 17 0 00 000000 popj p, 402034' 200 04 0 00 000002 noput: move d,b ;error routine if not open for write 402035' 201 01 0 00 600216 movei a,iox2 ;write priv req 402036' 202 01 0 04 000003 movem a,filerr(d) 402037' 254 00 0 00 405105' jrst erp. ;This routine is called when we get an error upon attempting access ; to a page. It makes assumes that the caller uses the following ; sequence: ; aos filcby(b) ; sos filbct(b) ; idpb a,filbpt(b) ; ercal maperr ; as it will undo the sideeffects of these operations if necessary. ; When a hole is found, we just have to set a to zero after clearing ; the page. ; But on a real error, we have to back out all the operations shown ; and abort the caller. 402040' maperr: ;for tops-20 the most likely thing here is that we tried to read a ; hole in the file. Tops-20 gives an ill mem read in that case. ;Also, it may be quota exceeded. ;So the code comes in these pieces: ; diagnose it - hole in the file? ; if a hole, then give a zero page ; else, print an error message and back out of the I/O operation ife tenex,< 402040' 261 17 0 00 000002 push p,b ;see if page exists ;First see if we have a quota problem PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402041' 261 17 0 00 000001 push p,a repeat 1,< ;This is due to a monitor bug. 402042' 200 01 0 00 406735' move a,[point 7,a] ;do an ILDB to clear first part done 402043' 134 01 0 00 000001 ildb a,a ;since ERCAL may leave it set > ;repeat 1 402044' 201 01 0 00 400000 movei a,400000 ;see what error 402045' 104 00 0 00 000012 geter 402046' 621 02 0 00 777777 tlz b,777777 ;b _ error code 402047' 306 02 0 00 601440 cain b,iox11 ;if quota error 402050' 254 00 0 00 402076' jrst mapquo ;special handling 402051' 262 17 0 00 000001 pop p,a ;here we check to see if the page is perhaps nonexistent in the file ;if so, we treat it as zeros. 402052' 200 02 0 17 000000 move b,0(p) ;[35] get back FCB 402053' 550 01 0 02 000035 hrrz a,filbpt(b) ;addr of core page 402054' 242 01 0 00 777767 lsh a,-11 ;convert to page 402055' 505 01 0 00 400000 hrli a,.fhslf ;in out fork 402056' 104 00 0 00 000057 rpacs 402057' 320 16 0 00 402121' erjmp maper3 ;treat this as an I/O error ;The case we are looking for is read-only access and an indirect pointer 402060' 607 02 0 00 040000 tlnn b,(pa%wt) ;if have write access, not this problem 402061' 607 02 0 00 004000 tlnn b,(pa%ind) ;if indirect too, that is it 402062' 254 00 0 00 402121' jrst maper3 ;write access or not indirect: normal error ;here if it is a hole. clear the page 402063' 200 02 0 00 000001 maper1: move b,a ;b _ .fhslf,,core page no. 402064' 474 01 0 00 000000 seto a, ;clear page 402065' 261 17 0 00 000003 push p,c 402066' 400 03 0 00 000000 setz c, ;no counts 402067' 104 00 0 00 000056 pmap 402070' 320 17 0 00 405006' chkquo ;[27] 402071' 320 16 0 00 402120' erjmp maper2 ;can't clear page 402072' 262 17 0 00 000003 pop p,c 402073' 262 17 0 00 000002 pop p,b 402074' 400 01 0 00 000000 setz a, ;return zero byte 402075' 263 17 0 00 000000 popj p, ;here if is a quota error, to retry 402076' 261 17 0 00 000003 mapquo: push p,c ;error message 402077' 561 01 0 00 406736' hrroi a,[asciz / Quota exceeded or disk full at /] 402100' 104 00 0 00 000313 esout 402101' 201 01 0 00 000101 movei a,.priou 402102' 370 00 0 17 777775 sos -3(p) ;adjust ret addr to go back to idpb 402103' 370 00 0 17 777775 sos -3(p) 402104' 550 02 0 17 777775 hrrz b,-3(p) 402105' 201 03 0 00 000010 movei c,10 ;base 8 402106' 104 00 0 00 000224 nout 402107' 255 00 0 00 000000 jfcl ;not sure how to handle errors here hrroi a,[asciz / [Find some space, then type CONTINUE] 402110' 561 01 0 00 406745' /] 402111' 104 00 0 00 000076 psout ; Finally we are ready to restore to the user's context and continue, ; if user types CONTINUE 402112' 262 17 0 00 000003 pop p,c PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-2 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402113' 262 17 0 00 000001 pop p,a 402114' 262 17 0 00 000002 pop p,b 402115' 104 00 0 00 000170 haltf ;let him delete some files 402116' 105 17 0 00 777777 adjstk p,-1 ;go retry 402117' 254 02 1 17 000001 jrstf @1(p) ;must use jrstf to restore first part done ife klcpu, ;If you want to use a non-KL DEC-20, you will have to write a routine to ;simulate adjbp. It must be able to handle any byte size. ;here is the beginning of the true error code. 402120' 262 17 0 00 000003 maper2: pop p,c 402121' 262 17 0 00 000002 maper3: pop p,b > ;ife tenex 402122' 370 00 0 02 000013 sos filcby(b) ;move back 402123' 350 00 0 02 000034 aos filbct(b) ifn klcpu,< ;[5] 402124' 211 01 0 00 000001 movni a,1 402125' 133 01 0 02 000035 adjbp a,filbpt(b) 402126' 202 01 0 02 000035 movem a,filbpt(b) > ;[5] ifn klcpu ife klcpu,< ;[5] start ;****** Tenex hackers, note: this code assume byte size = 7, not always true. sos filbpt(b) repeat 4, > ;[5] end ife klcpu 402127' 262 17 0 17 000000 pop p,(p) ;abort caller 402130' 254 00 0 00 405065' jrst ioerp ;get 402131' 350 01 0 02 000013 getchd: aos a,filcby(b) ;advance current byte 402132' 317 01 0 02 000012 camg a,fillby(b) ;beyond eof? 402133' 254 00 0 00 402145' jrst getcd1 ;no - do normal input 402134' 370 00 0 02 000013 dskeof: sos filcby(b) ;yes - don't do the advance ;jrst simeof ;simeof - simulate eof for pmap, texti (etc.?) 402135' 200 00 0 02 000007 simeof: move t,filbad(b) ;yes - set eof 402136' 202 00 0 02 000001 movem t,fileof(b) 402137' 202 00 0 02 000002 movem t,fileol(b) 402140' 331 00 0 02 000032 skipl filcnt(b) ;if ascii 402141' 402 00 0 02 000043 setzm filcmp(b) ;clear buffer, for read/ln 402142' 201 00 0 00 600220 movei t,iox4 ;simulate monitor eof error code 402143' 202 00 0 02 000003 movem t,filerr(b) 402144' 263 17 0 00 000000 popj p, 402145' 375 00 0 02 000034 getcd1: sosge filbct(b) ;count bytes left in this buffer 402146' 260 17 1 02 000011 pushj p,@filadv(b) ;none - get new buffer 402147' 134 01 0 02 000035 ildb a,filbpt(b) ;get character 402150' 320 17 0 00 402040' ercal maperr 402151' 200 00 0 02 000014 move t,fillts(b) ;line no. test bit if 7 bit mode 402152' 612 00 1 02 000035 tdne t,@filbpt(b) ;was it a line no.? PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-3 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402153' 254 00 0 00 403235' jrst getcln ; yes 402154' 405 01 0 00 000177 andi a,177 ; no - be sure legal ascii 402155' 322 01 0 00 402131' jumpe a,getchd ;ignore nulls 402156' 200 01 1 02 000010 move a,@filcht(b) ;get eoln flag and mapped char 402157' 576 01 0 02 000002 hlrem a,fileol(b) ;put down eoln flag 402160' 552 01 0 02 000043 hrrzm a,filcmp(b) ;put down mapped char 402161' 312 01 0 00 406756' came a,[xwd -1," "] ;carriage return in official mode 402162' 263 17 0 00 000000 popj p, 402163' 260 17 1 02 000016 geteol: pushj p,@filget(b) ;we have a CR, look for real EOL 402164' 332 00 0 02 000001 skipe fileof(b) ;stop after errors 402165' 263 17 0 00 000000 popj p, 402166' 337 00 0 02 000002 skipg fileol(b) ;real EOL? 402167' 254 00 0 00 402163' jrst geteol ;no, next char 402170' 263 17 0 00 000000 popj p, ;yes, done define letter, ;real letter define lc, ;upper case equiv. of lower case letter define linech(x), ;end of line char 402171' norcht: 402171' beg==norcht repeat 12, ;0 - 11 402171' 000000 000000 402172' 000000 000001 402173' 000000 000002 402174' 000000 000003 402175' 000000 000004 402176' 000000 000005 402177' 000000 000006 402200' 000000 000007 402201' 000000 000010 402202' 000000 000011 402203' 000001 000012 linech 1 ;12 402204' 000000 000013 letter ;13 402205' 000001 000014 linech 1 ;14 402206' 777777 000015 linech -1 ;15 repeat 14, ;16 - 31 402207' 000000 000016 402210' 000000 000017 402211' 000000 000020 402212' 000000 000021 402213' 000000 000022 402214' 000000 000023 402215' 000000 000024 402216' 000000 000025 402217' 000000 000026 402220' 000000 000027 402221' 000000 000030 402222' 000000 000031 402223' 000001 000032 linech 1 ;32 402224' 000001 000033 linech 1 ;33 repeat 3, ;34 - 36 402225' 000000 000034 402226' 000000 000035 402227' 000000 000036 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-4 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines ifn tenex, ;37 402230' 000000 000037 ife tenex, ;37 repeat 162, ;everything else is a letter 402231' 000000 000040 402232' 000000 000041 402233' 000000 000042 402234' 000000 000043 402235' 000000 000044 402236' 000000 000045 402237' 000000 000046 402240' 000000 000047 402241' 000000 000050 402242' 000000 000051 402243' 000000 000052 402244' 000000 000053 402245' 000000 000054 402246' 000000 000055 402247' 000000 000056 402250' 000000 000057 402251' 000000 000060 402252' 000000 000061 402253' 000000 000062 402254' 000000 000063 402255' 000000 000064 402256' 000000 000065 402257' 000000 000066 402260' 000000 000067 402261' 000000 000070 402262' 000000 000071 402263' 000000 000072 402264' 000000 000073 402265' 000000 000074 402266' 000000 000075 402267' 000000 000076 402270' 000000 000077 402271' 000000 000100 402272' 000000 000101 402273' 000000 000102 402274' 000000 000103 402275' 000000 000104 402276' 000000 000105 402277' 000000 000106 402300' 000000 000107 402301' 000000 000110 402302' 000000 000111 402303' 000000 000112 402304' 000000 000113 402305' 000000 000114 402306' 000000 000115 402307' 000000 000116 402310' 000000 000117 402311' 000000 000120 402312' 000000 000121 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-5 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402313' 000000 000122 402314' 000000 000123 402315' 000000 000124 402316' 000000 000125 402317' 000000 000126 402320' 000000 000127 402321' 000000 000130 402322' 000000 000131 402323' 000000 000132 402324' 000000 000133 402325' 000000 000134 402326' 000000 000135 402327' 000000 000136 402330' 000000 000137 402331' 000000 000140 402332' 000000 000141 402333' 000000 000142 402334' 000000 000143 402335' 000000 000144 402336' 000000 000145 402337' 000000 000146 402340' 000000 000147 402341' 000000 000150 402342' 000000 000151 402343' 000000 000152 402344' 000000 000153 402345' 000000 000154 402346' 000000 000155 402347' 000000 000156 402350' 000000 000157 402351' 000000 000160 402352' 000000 000161 402353' 000000 000162 402354' 000000 000163 402355' 000000 000164 402356' 000000 000165 402357' 000000 000166 402360' 000000 000167 402361' 000000 000170 402362' 000000 000171 402363' 000000 000172 402364' 000000 000173 402365' 000000 000174 402366' 000000 000175 402367' 000000 000176 402370' 000000 000177 402371' 000000 000200 402372' 000000 000201 402373' 000000 000202 402374' 000000 000203 402375' 000000 000204 402376' 000000 000205 402377' 000000 000206 402400' 000000 000207 402401' 000000 000210 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-6 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402402' 000000 000211 402403' 000000 000212 402404' 000000 000213 402405' 000000 000214 402406' 000000 000215 402407' 000000 000216 402410' 000000 000217 402411' 000000 000220 402412' 000000 000221 402413' lccht: 402413' beg==lccht repeat 12, 402413' 000000 000000 402414' 000000 000001 402415' 000000 000002 402416' 000000 000003 402417' 000000 000004 402420' 000000 000005 402421' 000000 000006 402422' 000000 000007 402423' 000000 000010 402424' 000000 000011 402425' 000001 000012 linech 1 402426' 000000 000013 letter 402427' 000001 000014 linech 1 402430' 777777 000015 linech -1 repeat 14, 402431' 000000 000016 402432' 000000 000017 402433' 000000 000020 402434' 000000 000021 402435' 000000 000022 402436' 000000 000023 402437' 000000 000024 402440' 000000 000025 402441' 000000 000026 402442' 000000 000027 402443' 000000 000030 402444' 000000 000031 402445' 000001 000032 linech 1 402446' 000001 000033 linech 1 ;33 repeat 3, ;34 - 36 402447' 000000 000034 402450' 000000 000035 402451' 000000 000036 ifn tenex, ;37 402452' 000000 000037 ife tenex, ;37 repeat 101, ;40 - 140 402453' 000000 000040 402454' 000000 000041 402455' 000000 000042 402456' 000000 000043 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-7 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402457' 000000 000044 402460' 000000 000045 402461' 000000 000046 402462' 000000 000047 402463' 000000 000050 402464' 000000 000051 402465' 000000 000052 402466' 000000 000053 402467' 000000 000054 402470' 000000 000055 402471' 000000 000056 402472' 000000 000057 402473' 000000 000060 402474' 000000 000061 402475' 000000 000062 402476' 000000 000063 402477' 000000 000064 402500' 000000 000065 402501' 000000 000066 402502' 000000 000067 402503' 000000 000070 402504' 000000 000071 402505' 000000 000072 402506' 000000 000073 402507' 000000 000074 402510' 000000 000075 402511' 000000 000076 402512' 000000 000077 402513' 000000 000100 402514' 000000 000101 402515' 000000 000102 402516' 000000 000103 402517' 000000 000104 402520' 000000 000105 402521' 000000 000106 402522' 000000 000107 402523' 000000 000110 402524' 000000 000111 402525' 000000 000112 402526' 000000 000113 402527' 000000 000114 402530' 000000 000115 402531' 000000 000116 402532' 000000 000117 402533' 000000 000120 402534' 000000 000121 402535' 000000 000122 402536' 000000 000123 402537' 000000 000124 402540' 000000 000125 402541' 000000 000126 402542' 000000 000127 402543' 000000 000130 402544' 000000 000131 402545' 000000 000132 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-8 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402546' 000000 000133 402547' 000000 000134 402550' 000000 000135 402551' 000000 000136 402552' 000000 000137 402553' 000000 000140 repeat 32, ;141 - 172 402554' 000000 000101 402555' 000000 000102 402556' 000000 000103 402557' 000000 000104 402560' 000000 000105 402561' 000000 000106 402562' 000000 000107 402563' 000000 000110 402564' 000000 000111 402565' 000000 000112 402566' 000000 000113 402567' 000000 000114 402570' 000000 000115 402571' 000000 000116 402572' 000000 000117 402573' 000000 000120 402574' 000000 000121 402575' 000000 000122 402576' 000000 000123 402577' 000000 000124 402600' 000000 000125 402601' 000000 000126 402602' 000000 000127 402603' 000000 000130 402604' 000000 000131 402605' 000000 000132 repeat 5, ;173 - 177 402606' 000000 000173 402607' 000000 000174 402610' 000000 000175 402611' 000000 000176 402612' 000000 000177 ; ;Now the tables for standard pascal semantics - replace EOLN by space ; define linech(x), ;end of line char ;otherwise the tables are the same 402613' norchx: 402613' beg==norchx repeat 12, ;0 - 11 402613' 000000 000000 402614' 000000 000001 402615' 000000 000002 402616' 000000 000003 402617' 000000 000004 402620' 000000 000005 402621' 000000 000006 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-9 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402622' 000000 000007 402623' 000000 000010 402624' 000000 000011 402625' 000001 000040 linech 1 ;12 402626' 000000 000013 letter ;13 402627' 000001 000040 linech 1 ;14 402630' 777777 000040 linech -1 ;15 repeat 14, ;16 - 31 402631' 000000 000016 402632' 000000 000017 402633' 000000 000020 402634' 000000 000021 402635' 000000 000022 402636' 000000 000023 402637' 000000 000024 402640' 000000 000025 402641' 000000 000026 402642' 000000 000027 402643' 000000 000030 402644' 000000 000031 402645' 000001 000040 linech 1 ;32 402646' 000001 000040 linech 1 ;33 repeat 3, ;34 - 36 402647' 000000 000034 402650' 000000 000035 402651' 000000 000036 ifn tenex, ;37 402652' 000000 000037 ife tenex, ;37 repeat 162, ;everything else is a letter 402653' 000000 000040 402654' 000000 000041 402655' 000000 000042 402656' 000000 000043 402657' 000000 000044 402660' 000000 000045 402661' 000000 000046 402662' 000000 000047 402663' 000000 000050 402664' 000000 000051 402665' 000000 000052 402666' 000000 000053 402667' 000000 000054 402670' 000000 000055 402671' 000000 000056 402672' 000000 000057 402673' 000000 000060 402674' 000000 000061 402675' 000000 000062 402676' 000000 000063 402677' 000000 000064 402700' 000000 000065 402701' 000000 000066 402702' 000000 000067 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-10 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402703' 000000 000070 402704' 000000 000071 402705' 000000 000072 402706' 000000 000073 402707' 000000 000074 402710' 000000 000075 402711' 000000 000076 402712' 000000 000077 402713' 000000 000100 402714' 000000 000101 402715' 000000 000102 402716' 000000 000103 402717' 000000 000104 402720' 000000 000105 402721' 000000 000106 402722' 000000 000107 402723' 000000 000110 402724' 000000 000111 402725' 000000 000112 402726' 000000 000113 402727' 000000 000114 402730' 000000 000115 402731' 000000 000116 402732' 000000 000117 402733' 000000 000120 402734' 000000 000121 402735' 000000 000122 402736' 000000 000123 402737' 000000 000124 402740' 000000 000125 402741' 000000 000126 402742' 000000 000127 402743' 000000 000130 402744' 000000 000131 402745' 000000 000132 402746' 000000 000133 402747' 000000 000134 402750' 000000 000135 402751' 000000 000136 402752' 000000 000137 402753' 000000 000140 402754' 000000 000141 402755' 000000 000142 402756' 000000 000143 402757' 000000 000144 402760' 000000 000145 402761' 000000 000146 402762' 000000 000147 402763' 000000 000150 402764' 000000 000151 402765' 000000 000152 402766' 000000 000153 402767' 000000 000154 402770' 000000 000155 402771' 000000 000156 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-11 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 402772' 000000 000157 402773' 000000 000160 402774' 000000 000161 402775' 000000 000162 402776' 000000 000163 402777' 000000 000164 403000' 000000 000165 403001' 000000 000166 403002' 000000 000167 403003' 000000 000170 403004' 000000 000171 403005' 000000 000172 403006' 000000 000173 403007' 000000 000174 403010' 000000 000175 403011' 000000 000176 403012' 000000 000177 403013' 000000 000200 403014' 000000 000201 403015' 000000 000202 403016' 000000 000203 403017' 000000 000204 403020' 000000 000205 403021' 000000 000206 403022' 000000 000207 403023' 000000 000210 403024' 000000 000211 403025' 000000 000212 403026' 000000 000213 403027' 000000 000214 403030' 000000 000215 403031' 000000 000216 403032' 000000 000217 403033' 000000 000220 403034' 000000 000221 403035' lcchx: 403035' beg==lcchx repeat 12, 403035' 000000 000000 403036' 000000 000001 403037' 000000 000002 403040' 000000 000003 403041' 000000 000004 403042' 000000 000005 403043' 000000 000006 403044' 000000 000007 403045' 000000 000010 403046' 000000 000011 403047' 000001 000040 linech 1 403050' 000000 000013 letter 403051' 000001 000040 linech 1 403052' 777777 000040 linech -1 repeat 14, 403053' 000000 000016 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-12 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 403054' 000000 000017 403055' 000000 000020 403056' 000000 000021 403057' 000000 000022 403060' 000000 000023 403061' 000000 000024 403062' 000000 000025 403063' 000000 000026 403064' 000000 000027 403065' 000000 000030 403066' 000000 000031 403067' 000001 000040 linech 1 403070' 000001 000040 linech 1 ;33 repeat 3, ;34 - 36 403071' 000000 000034 403072' 000000 000035 403073' 000000 000036 ifn tenex, ;37 403074' 000000 000037 ife tenex, ;37 repeat 101, ;40 - 140 403075' 000000 000040 403076' 000000 000041 403077' 000000 000042 403100' 000000 000043 403101' 000000 000044 403102' 000000 000045 403103' 000000 000046 403104' 000000 000047 403105' 000000 000050 403106' 000000 000051 403107' 000000 000052 403110' 000000 000053 403111' 000000 000054 403112' 000000 000055 403113' 000000 000056 403114' 000000 000057 403115' 000000 000060 403116' 000000 000061 403117' 000000 000062 403120' 000000 000063 403121' 000000 000064 403122' 000000 000065 403123' 000000 000066 403124' 000000 000067 403125' 000000 000070 403126' 000000 000071 403127' 000000 000072 403130' 000000 000073 403131' 000000 000074 403132' 000000 000075 403133' 000000 000076 403134' 000000 000077 403135' 000000 000100 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-13 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 403136' 000000 000101 403137' 000000 000102 403140' 000000 000103 403141' 000000 000104 403142' 000000 000105 403143' 000000 000106 403144' 000000 000107 403145' 000000 000110 403146' 000000 000111 403147' 000000 000112 403150' 000000 000113 403151' 000000 000114 403152' 000000 000115 403153' 000000 000116 403154' 000000 000117 403155' 000000 000120 403156' 000000 000121 403157' 000000 000122 403160' 000000 000123 403161' 000000 000124 403162' 000000 000125 403163' 000000 000126 403164' 000000 000127 403165' 000000 000130 403166' 000000 000131 403167' 000000 000132 403170' 000000 000133 403171' 000000 000134 403172' 000000 000135 403173' 000000 000136 403174' 000000 000137 403175' 000000 000140 repeat 32, ;141 - 172 403176' 000000 000101 403177' 000000 000102 403200' 000000 000103 403201' 000000 000104 403202' 000000 000105 403203' 000000 000106 403204' 000000 000107 403205' 000000 000110 403206' 000000 000111 403207' 000000 000112 403210' 000000 000113 403211' 000000 000114 403212' 000000 000115 403213' 000000 000116 403214' 000000 000117 403215' 000000 000120 403216' 000000 000121 403217' 000000 000122 403220' 000000 000123 403221' 000000 000124 403222' 000000 000125 403223' 000000 000126 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 10-14 PASIO MAC 7-Mar-81 20:52 pmap I/O - ascii top-level routines 403224' 000000 000127 403225' 000000 000130 403226' 000000 000131 403227' 000000 000132 repeat 5, ;173 - 177 403230' 000000 000173 403231' 000000 000174 403232' 000000 000175 403233' 000000 000176 403234' 000000 000177 ;called by get to skip line no. 403235' 200 00 1 02 000035 getcln: move t,@filbpt(b) ;line no. - get it 403236' 202 00 0 02 000031 movem t,fillnr(b) ;save it for user 403237' 350 00 0 02 000035 aos filbpt(b) ;skip it 403240' 201 00 0 00 000005 movei t,5 ;update currentposition 403241' 272 00 0 02 000013 addm t,filcby(b) 403242' 211 00 0 00 000005 movni t,5 ;note getchb already skipped one char, so 403243' 273 00 0 02 000034 addb t,filbct(b) ; we only skip 5 403244' 325 00 0 00 402131' jumpge t,getchd ;now get real character ;the context in which filadv is valid is where we have just done sosge filbct, ;and are about to do ildb. Usually this is right, as in the subtraction of ;5 above, 1 of the 5 is in the new block. so that is the sosge. we will ;still have to do an ibp afterwards, though. If we are further into the ;word than the first char, we now back up, since filadv will leave us at ;the start of the buffer (and its error handling is predicated on the ;assumption that we are working on the first char) 403245' 271 00 0 00 000001 addi t,1 ;if more than one char into new buffer 403246' 272 00 0 02 000013 addm t,filcby(b) ;move back (T is negative) 403247' 260 17 1 02 000011 pushj p,@filadv(b) ;go to new buffer 403250' 133 00 0 02 000035 ibp filbpt(b) ;pass over first char (tab) 403251' 254 00 0 00 402131' jrst getchd ;now go back for real char PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 11 PASIO MAC 7-Mar-81 20:52 pmap I/O - buffer advance and go to new page subttl pmap I/O - buffer advance and go to new page ;dskadv - get to the next page when reading sequentially. If ; the getpage succeeds, this gives new byte ptr, count, etc., for ; the new page. Otherwise you are left exactly where you were before, ; with filcby adjusted, since the caller is assumed to have ; incremented it. ; t,a - temps ; b up - preserved 403252' 200 00 0 02 000033 dskadv: move t,filpag(b) ;old page 403253' 271 00 0 00 000001 addi t,1 ;new page 403254' 260 17 0 00 403267' pushj p,getfpg ;get page routine 403255' 254 00 0 00 403264' jrst badadv ;can't get new page 403256' 200 00 0 02 000026 move t,filbfs(b) ;bytes in buffer 403257' 275 00 0 00 000001 subi t,1 ;caller has done sosge 403260' 202 00 0 02 000034 movem t,filbct(b) 403261' 200 00 0 02 000025 move t,filbfp(b) ;pointer to start of buffer 403262' 202 00 0 02 000035 movem t,filbpt(b) 403263' 263 17 0 00 000000 popj p, 403264' 370 00 0 02 000013 badadv: sos filcby(b) ;user has done aos on this 403265' 262 17 0 17 000000 pop p,(p) ;abort our caller 403266' 263 17 0 00 000000 popj p, ;getfpg - get specified page ; t - desired page - preserved ; a - temp ; b up - preserved ; returns: t - requested disk page ; also resets ; filbfp(RH) to point to the core page where the disk page is mapped ; filpag to indicate we are on a new file page ; filbgp if we have to remap the buffer, to indicate new beginning ; the user is assumed to adjust counts, pointers, etc., as he likes 403267' 200 01 0 00 000000 getfpg: move a,t ;a _ desired page 403270' 274 01 0 02 000036 sub a,filbgp(b) ;a _ pages beyond start of buffer 403271' 301 01 0 00 000000 cail a,0 ;if before buffer start 403272' 311 01 0 02 000024 caml a,filpgb(b) ;or after buffer end 403273' 254 00 0 00 403304' jrst getfpn ;need new pages ;here when desired page is in buffer 403274' 261 17 0 00 000003 push p,c 403275' 550 03 0 02 000015 hrrz c,filbuf(b) ;beginning of core buffer 403276' 242 01 0 00 000011 lsh a,11 ;convert page offset to word offset 403277' 270 01 0 00 000003 add a,c ;a _ core addr where we have file page 403300' 542 01 0 02 000025 hrrm a,filbfp(b) ;save as current buffer start 403301' 202 00 0 02 000033 movem t,filpag(b) ;also remember we are now where asked 403302' 262 17 0 00 000003 pop p,c 403303' 254 00 0 00 403326' jrst cpopj1 ;here when desired page is not in buffer 403304' 261 17 0 00 000003 getfpn: push p,c ;filadv routine for pmap I/O 403305' 261 17 0 00 000002 push p,b 403306' 540 01 0 00 000000 hrr a,t ;desired page 403307' 504 01 0 02 000004 hrl a,filjfn(b) ;on this file PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 11-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - buffer advance and go to new page ife tenex,< 403310' 544 03 0 02 000015 hlr c,filbuf(b) ;c _ page count for buffer 403311' 505 03 0 00 550000 hrli c,(pm%cnt!pm%rd!pm%wr!pm%pld) ;say we have a count, preload 403312' 550 02 0 02 000015 hrrz b,filbuf(b) ;address of buffer 403313' 242 02 0 00 777767 lsh b,-9 ;make page no. 403314' 505 02 0 00 400000 hrli b,400000 ;current process 403315' 104 00 0 00 000056 pmap 403316' 320 17 0 00 405006' chkquo ;[27] 403317' 320 16 0 00 403330' erjmp badpag > ;ife tenex ifn tenex,< push p,d ;d will be page count hlrz d,filbuf(b) movsi c,(pm%rd!pm%wr) hrrz b,filbuf(b) ;addr of buffer lsh b,-9 ;convert to page hrli b,400000 ;this process getfpl: pmap ;one page only addi a,1 ;go to next page addi b,1 sojg d,getfpl ;and do it if desired pop p,d > ;ifn tenex ;general success return 403320' 262 17 0 00 000002 gotpag: pop p,b 403321' 262 17 0 00 000003 pop p,c 403322' 202 00 0 02 000033 movem t,filpag(b) ;only now can we say are on that page 403323' 202 00 0 02 000036 movem t,filbgp(b) ;and that page is buffer begin 403324' 550 01 0 02 000015 hrrz a,filbuf(b) 403325' 542 01 0 02 000025 hrrm a,filbfp(b) ;and current page is first in buffer 403326' 350 00 0 17 000000 cpopj1: aos (p) ;skip return - success 403327' 263 17 0 00 000000 popj p, ;note that badpag is called with b&c saved on stack 403330' 262 17 0 00 000002 badpag: pop p,b ;we don't change filpag, as haven't moved 403331' 262 17 0 00 000003 pop p,c 403332' 254 00 0 00 405065' jrst ioerp ;gives non-skip (error) return PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 12 PASIO MAC 7-Mar-81 20:52 pmap I/O - actual I/O routines for record files subttl pmap I/O - actual I/O routines for record files ;The following routines set up C to indicate the desired ; transfer, and then call getdlp or putdlp, which simulate ; sin and sout. If an I/O error occurs, getdlp or putdlp ; will return with c as at the point of error. Thus the ; caller may have some adjustments to do. ;get 403333' 202 03 0 02 000027 getd: movem c,fillct(b) ;assume no. transferred = no. requested 403334' 210 03 0 00 000003 movn c,c ;make up aobjn word 403335' 504 03 0 00 000003 hrl c,c ;lh(c) _ no. to transfer 403336' 541 03 0 02 000043 hrri c,filcmp(b) ;rh(c) _ starting loc to transfer 403337' 260 17 0 00 403373' pushj p,getdlp ;sin 403340' 574 03 0 00 000003 hlre c,c ;c _ - no. left untransferred 403341' 272 03 0 02 000027 addm c,fillct(b) ;adjust assumption 403342' 263 17 0 00 000000 popj p, ;put 403343' 202 03 0 02 000027 putd: movem c,fillct(b) 403344' 210 03 0 00 000003 movn c,c 403345' 504 03 0 00 000003 hrl c,c 403346' 541 03 0 02 000043 hrri c,filcmp(b) 403347' 260 17 0 00 403405' pushj p,putdlp ;sout 403350' 574 03 0 00 000003 hlre c,c 403351' 272 03 0 02 000027 addm c,fillct(b) 403352' 263 17 0 00 000000 popj p, ;getx 403353' 200 04 0 00 000003 getxd: move d,c ;requested upper limit 403354' 274 03 0 02 000027 sub c,fillct(b) ;c _ no. needed this time 403355' 210 03 0 00 000003 movn c,c ;make aobjn word 403356' 504 03 0 00 000003 hrl c,c 403357' 541 03 0 02 000043 hrri c,filcmp(b) 403360' 270 03 0 02 000027 add c,fillct(b) ;adjust by no. already done 403361' 260 17 0 00 403373' pushj p,getdlp ;sin 403362' 574 03 0 00 000003 hlre c,c 403363' 272 03 0 02 000027 addm c,fillct(b) 403364' 263 17 0 00 000000 popj p, ;putx 403365' 200 03 0 02 000013 putxd: move c,filcby(b) ;go back to beginning of record 403366' 274 03 0 02 000027 sub c,fillct(b) ;c _ byte at beginning 403367' 260 17 0 00 403722' pushj p,dskmov ;move to beginning of record 403370' 263 17 0 00 000000 popj p, ;no - I/O error in setpos 403371' 200 03 0 02 000027 move c,fillct(b) ;get back no. to transfer 403372' 254 00 0 00 403343' jrst putd ;now put out the record ;Here are the sin/sout simulations. Note that if there is ; an I/O error, filadv will sos filcby(b) and abort the routine. ; In that case c will be left negative, and the caller (above) ; will do the right thing. ;sin 403373' 350 01 0 02 000013 getdlp: aos a,filcby(b) ;assume we are going to a new byte PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 12-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - actual I/O routines for record files 403374' 313 01 0 02 000012 camle a,fillby(b) ;beyond eof? 403375' 254 00 0 00 402134' jrst dskeof ;simulate eof 403376' 375 00 0 02 000034 sosge filbct(b) ;anything left in buffer? 403377' 260 17 1 02 000011 pushj p,@filadv(b) ;no - next buffer - may abort here 403400' 134 01 0 02 000035 ildb a,filbpt(b) 403401' 320 17 0 00 402040' ercal maperr 403402' 202 01 0 03 000000 movem a,(c) 403403' 253 03 0 00 403373' aobjn c,getdlp 403404' 263 17 0 00 000000 popj p, ;sout 403405' 350 01 0 02 000013 putdlp: aos a,filcby(b) ;assume we are going to a new byte 403406' 313 01 0 02 000012 camle a,fillby(b) ;beyond eof? 403407' 202 01 0 02 000012 movem a,fillby(b) ;update eof 403410' 375 00 0 02 000034 sosge filbct(b) 403411' 260 17 1 02 000011 pushj p,@filadv(b) 403412' 200 01 0 03 000000 move a,(c) 403413' 136 01 0 02 000035 idpb a,filbpt(b) 403414' 320 17 0 00 402040' ercal maperr 403415' 253 03 0 00 403405' aobjn c,putdlp 403416' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 13 PASIO MAC 7-Mar-81 20:52 pmap I/O - device dependent openning subttl pmap I/O - device dependent openning ;main entry to do openfi 403417' 332 00 0 02 000003 dskopn: skipe filerr(b) ;must be no-op if error in jfn 403420' 263 17 0 00 000000 popj p, 403421' 201 00 0 00 403252' movei t,dskadv ;disk advance routine 403422' 202 00 0 02 000011 movem t,filadv(b) 403423' 135 00 0 00 406757' ldb t,[point 6,g,5] ;get byte size 403424' 200 01 0 00 000000 move a,t ;a _ byte size 403425' 242 00 0 00 000030 lsh t,^D24 ;put in byte size position 403426' 202 00 0 02 000035 movem t,filbpt(b) ;in pointer 403427' 661 00 0 00 440000 tlo t,440000 ;byte pointer LH 403430' 502 00 0 02 000025 hllm t,filbfp(b) ;RH set up later (may be already) 403431' 201 00 0 00 000044 movei t,^D36 ;compute no. of bytes in a page 403432' 230 00 0 00 000001 idiv t,a ;t _ no. of bytes/word 403433' 242 00 0 00 000011 lsh t,9 ;t _ no. of bytes/page 403434' 202 00 0 02 000026 movem t,filbfs(b) ;save as public knowledge ;here we have to split according to the sort of open being done 403435' 602 07 0 00 020000 trne g,of%app ;special code to simulate append 403436' 254 00 0 00 403503' jrst dskapp 403437' 606 07 0 00 200000 trnn g,of%rd ;special code if write-only 403440' 254 00 0 00 403454' jrst dskwrt ;read or update - must be able to read, so pmap always works 403441' 602 07 0 00 100000 trne g,of%wr ;if only read 403442' 254 00 0 00 403447' jrst dskop1 ; not - ignore this ;read only 403443' 201 00 0 00 402034' movei t,noput ;disable writing 403444' 202 00 0 02 000017 movem t,filput(b) 403445' 201 00 0 00 403604' movei t,dskrcl ;use special close (doesn't change size) 403446' 202 00 0 02 000022 movem t,filclo(b) ;read or update again 403447' 260 17 0 00 401303' dskop1: pushj p,openfi 403450' 332 00 0 02 000003 skipe filerr(b) ;this may fail 403451' 263 17 0 00 000000 popj p, 403452' 260 17 0 00 403643' pushj p,sizefi ;set up end of file stuff 403453' 254 00 0 00 403527' jrst dskini ;write only 403454' 260 17 0 00 401303' dskwrt: pushj p,openfi 403455' 332 00 0 02 000003 skipe filerr(b) 403456' 263 17 0 00 000000 popj p, 403457' 550 01 0 02 000004 hrrz a,filjfn(b) ;see if we can read, too 403460' 200 10 0 00 000002 move h,b 403461' 104 00 0 00 000024 gtsts 403462' 320 16 0 00 401315' erjmp doope 403463' 607 02 0 00 200000 tlnn b,(gs%rdf) 403464' 254 00 0 00 403470' jrst dskbn1 ;can't read it, use normal binary mode 403465' 200 02 0 00 000010 move b,h 403466' 402 00 0 02 000012 setzm fillby(b) ;file is now zero length 403467' 254 00 0 00 403527' jrst dskini ;here to exit to normal binary routines in case can't use pmap. DEC ;requires read priv's to do pmap, although tenex doesn't 403470' 200 02 0 00 000010 dskbn1: move b,h 403471' 540 01 0 02 000004 hrr a,filjfn(b) ;It's open - close it 403472' 505 01 0 00 400000 hrli a,(co%nrj) 403473' 104 00 0 00 000022 closf PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 13-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - device dependent openning 403474' 320 16 0 00 401314' erjrst oper ;[7] 403475' 505 00 0 00 401073' dskbin: hrli t,chrtxt ;change to normal mode 403476' 335 00 0 02 000032 skipge filcnt(b) 403477' 505 00 0 00 401114' hrli t,chrrec 403500' 541 00 0 02 000016 hrri t,filr11(b) 403501' 251 00 0 02 000023 blt t,filr99(b) 403502' 254 00 0 00 405716' jrst chropn ;now open in real mode ;append simulation 403503' 640 07 0 00 320000 dskapp: trc g,of%app!of%rd!of%wr 403504' 260 17 0 00 403517' pushj p,dopenf ;try read/write open 403505' 254 00 0 00 403515' jrst appbin ;failed, so try real append 403506' 260 17 0 00 403643' pushj p,sizefi ;find end of file 403507' 332 00 0 02 000003 skipe filerr(b) ;it can fail 403510' 263 17 0 00 000000 popj p, 403511' 260 17 0 00 403527' pushj p,dskini 403512' 200 03 0 02 000012 move c,fillby(b) ;go to end 403513' 400 04 0 00 000000 setz d, ;suppress get 403514' 254 00 0 00 403674' jrst dskspo ;here to ext to normal binary routines in case can't append using pmap 403515' 640 07 0 00 320000 appbin: trc g,of%app!of%rd!of%wr 403516' 254 00 0 00 403475' jrst dskbin ;here to do openf for dskapp - needs special routine so we don't ; trigger error processing if it fails. 403517' 200 10 0 00 000002 dopenf: move h,b ;save b 403520' 550 01 0 10 000004 hrrz a,filjfn(h) 403521' 200 02 0 00 000007 move b,g 403522' 104 00 0 00 000021 openf 403523' 320 16 0 00 403525' erjrst cpopjh ;[5] 403524' 350 00 0 17 000000 aos (p) ;good return 403525' 200 02 0 00 000010 cpopjh: move b,h ;bad return 403526' 263 17 0 00 000000 popj p, ;These are common initializations that must not be done until ;we know the open succeeded 403527' 402 00 0 02 000034 dskini: setzm filbct(b) 403530' 476 00 0 02 000033 setom filpag(b) 403531' 211 00 0 00 377777 movni t,377777 ;force us to get new page 403532' 202 00 0 02 000036 movem t,filbgp(b) 403533' 402 00 0 02 000013 setzm filcby(b) 403534' 135 01 0 00 406760' ldb a,[fl%buf!filflg(b)] ;number of buffers user wants 403535' 307 01 0 00 000000 caig a,0 ;must be between 1 and 36 403536' 201 01 0 00 000004 movei a,mapbfs ;if 0, use default 403537' 303 01 0 00 000044 caile a,^D36 ;if too big, use maximum 403540' 201 01 0 00 000044 movei a,^D36 403541' 202 01 0 02 000024 movem a,filpgb(b) ;save as buffer size in pages 403542' 260 17 0 00 403546' pushj p,alcbuf ;# pages is arg to alcbuf, in A 403543' 200 00 0 02 000015 move t,filbuf(b) 403544' 542 00 0 02 000025 hrrm t,filbfp(b) ;LH was set up at beginning 403545' 263 17 0 00 000000 popj p, ;alcbuf - allocation a page as a buffer - used elsewhere, too ; a - number of pages to allocate 403546' 554 00 0 02 000015 alcbuf: hlrz t,filbuf(b) ;any buffer already? 403547' 322 00 0 00 403556' jumpe t,alcbfn ;no, get a new one PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 13-2 PASIO MAC 7-Mar-81 20:52 pmap I/O - device dependent openning 403550' 316 00 0 00 000001 camn t,a ;yes, right size? 403551' 263 17 0 00 000000 popj p, ;yes, nothing to do 403552' 261 17 0 00 000001 push p,a 403553' 200 01 0 02 000015 move a,filbuf(b) ;no, throw it away 403554' 260 17 0 00 406422' pushj p,relpg. 403555' 262 17 0 00 000001 pop p,a 403556' 260 17 0 00 406315' alcbfn: pushj p,getpg. ;get a new buffer 403557' 202 01 0 02 000015 movem a,filbuf(b) ;store size,,addr 403560' 263 17 0 00 000000 popj p, ife srisw,< ;[23] ;Here is the normal code for turning on the line number test. ;It turns it on for all text files with byte size 7. If there ;are no line numbers in the file, of course everything is fine. ;This routine is considered device-dependent, since it is called only ;for devices capable of having line numbers. For other devices, the ;test is simply CPOPJ, which leaves the test bit (FILLTS) 0. This ;disables the test. This distinction is just for safety, though ;presumably such devices wouldn't have line numbers anyway. 403561' wrdlts: 403561' 135 00 0 00 406761' dsklts: ldb t,[point 6,filbfp(b),11] ;get byte size 403562' 302 00 0 00 000007 caie t,7 ;if not 7 403563' 263 17 0 00 000000 popj p, ;can't be line numbered 403564' 350 00 0 02 000014 aos fillts(b) ;is line number - set fillts 403565' 263 17 0 00 000000 popj p, > ;[23] ife srisw ifn srisw,< ;[23] ;This code is because SRI's EMACS puts random low-order bits into ;files. Thus we have to test the first word of the file to see if ;it is a line number, and turn off testing if not. ;xxxlts - device-dependent routine to see if this is a line-numbered ; file. Only devices that read full words have such a routine. Others ; use CPOPJ, which results in fillts still being zero for them. Error ; processing is a big pain in the neck, since we really want to save ; eof and errors for the first real read. So we generally have to ; bypass the normal I/O routines. These routines depend upon the fact ; that a line numbered file must begin with a line number. We have to ; enforce this since EMACS tends to create things that look like line ; numbers by setting the low order bit randomly throughout the file. dsklts: movei t,0 ;get page 0 of file skiple fillby(b) ;[17] if file is zero size, not numbered pushj p,getfpg popj p, ;if can't get page 0,not numbered setom filpag(b) ;pretend we didn't read the page move a,filbfp(b) ;get addr of first word move t,(a) ;get first word erjmp cpopj ;if error, not linenumbered ;comlts - entry for testing line number. first byte of file in t comlts: ldb a,[point 6,filbfp(b),11] ;get byte size trze t,1 ;if low order bit off or caie a,7 ;if not 7 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 13-3 PASIO MAC 7-Mar-81 20:52 pmap I/O - device dependent openning popj p, ;can't be line numbered camn t,[ascii / /] ;this is a page mark jrst isnum ;which is OK to start the file movei a,5 ;otherwise must be digits move c,[point 7,t] ;get from t comlt1: ildb d,c ;next digit cail d,"0" ;if not digit caile d,"9" popj p, ;isn't a line number sojg a,comlt1 ;go back for next isnum: aos fillts(b) ;is line number - set fillts popj p, > ;[23] ifn srisw PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 14 PASIO MAC 7-Mar-81 20:52 pmap I/O - device-dependent routines subttl pmap I/O - device-dependent routines ;break 403566' 335 00 0 02 000036 dskbrk: skipge filbgp(b) ;break function - force out buffer 403567' 263 17 0 00 000000 popj p, 403570' 200 01 0 02 000015 move a,filbuf(b) ;count,,buf addr 403571' 200 04 0 00 000002 move d,b ;save fcb ife tenex,< 403572' 554 03 0 00 000001 hlrz c,a ;count in rh of c 403573' 135 02 0 00 406653' ldb b,[point 9,a,26] ;page no. 403574' 505 02 0 00 400000 hrli b,400000 ;in this process 403575' 474 01 0 00 000000 seto a, ;clear the page 403576' 505 03 0 00 400000 hrli c,(pm%cnt) ;do all at once 403577' 104 00 0 00 000056 pmap 403600' 320 17 0 00 405006' chkquo ;[27] 403601' 320 16 0 00 405064' erjmp ioer ;no errors here, please > ;ife tenex ifn tenex,< hlrz t,a ;count of pages to be released ldb b,[point 9,a,26] ;page no. hrli b,400000 ;in this process seto a, ;clear the page setz c, dskbrl: pmap addi b,1 ;next page sojg t,dskbrl ;if any > ;ifn tenex 403602' 200 02 0 00 000004 move b,d 403603' 263 17 0 00 000000 popj p, ;close for read-only modes 403604' 261 17 0 00 000003 dskrcl: push p,c ;special close that doesn't change size 403605' 261 17 0 00 000004 push p,d 403606' 254 00 0 00 403637' jrst dskcl1 ;breakin 403607' 402 00 0 02 000034 dskbri: setzm filbct(b) ;breakin function - clear buffer 403610' 476 00 0 02 000033 setom filpag(b) 403611' 211 00 0 00 377777 movni t,377777 ;force us to get new page 403612' 202 00 0 02 000036 movem t,filbgp(b) 403613' 402 00 0 02 000013 setzm filcby(b) 403614' 402 00 0 02 000027 setzm fillct(b) 403615' 263 17 0 00 000000 popj p, ;close for read/write modes 403616' 261 17 0 00 000003 dskclo: push p,c 403617' 261 17 0 00 000004 push p,d ;filclo allows only t and a free 403620' 261 17 0 00 000002 push p,b ;now we will reset the eof pointer ifn tenex, ;the offset - byte size 403621' 505 01 0 00 400011 ife tenex, ;same, suppress updating disk copy 403622' 540 01 0 02 000004 hrr a,filjfn(b) 403623' 200 03 0 02 000035 move c,filbpt(b) 403624' 515 02 0 00 007700 hrlzi b,007700 ;mask 403625' 104 00 0 00 000064 chfdb 403626' 320 16 0 00 403627' erjmp .+1 ;if not open for output, ignore PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 14-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - device-dependent routines 403627' 200 02 0 17 000000 move b,(p) ;restore b 403630' 505 01 0 00 000012 hrli a,.fbsiz ;no. of bytes 403631' 540 01 0 02 000004 hrr a,filjfn(b) 403632' 200 03 0 02 000012 move c,fillby(b) 403633' 474 02 0 00 000000 seto b, ;all bits 403634' 104 00 0 00 000064 chfdb 403635' 320 16 0 00 403636' erjmp .+1 403636' 262 17 0 00 000002 pop p,b 403637' 260 17 0 00 403566' dskcl1: pushj p,dskbrk ;close - force last buffer 403640' 262 17 0 00 000004 pop p,d 403641' 262 17 0 00 000003 pop p,c 403642' 263 17 0 00 000000 popj p, ;This doesn't belong here, is called by open 403643' 200 10 0 00 000002 sizefi: move h,b ;compute last byte no. 403644' 550 01 0 10 000004 hrrz a,filjfn(h) 403645' 200 02 0 00 406762' move b,[xwd 2,.fbbyv] 403646' 201 03 0 00 000002 movei c,b ;put b _ byte size, c _ bytes in file 403647' 104 00 0 00 000063 gtfdb ;get from fdb 403650' 320 16 0 00 401315' erjmp doope 403651' 135 00 0 00 406763' ldb t,[point 6,filbpt(h),11] ;t _ our byte size 403652' 135 01 0 00 406764' ldb a,[point 6,b,11] ;a _ file's byte size 403653' 306 01 0 00 000000 cain a,0 ;[2] if zero 403654' 201 01 0 00 000044 movei a,^D36 ;[2] use 36 to prevent divide by 0 403655' 316 01 0 00 000000 camn a,t 403656' 254 00 0 00 403671' jrst sambsz ;if same, use exact calculation 403657' 275 03 0 00 000001 subi c,1 ;else do in words 403660' 261 17 0 00 000005 push p,e ;resetf needs e preserved 403661' 201 04 0 00 000044 movei d,^D36 403662' 230 04 0 00 000001 idiv d,a ;d _ file bytes/wd 403663' 230 03 0 00 000004 idiv c,d ;c _ file words - 1 403664' 271 03 0 00 000001 addi c,1 403665' 201 04 0 00 000044 movei d,^D36 403666' 230 04 0 00 000000 idiv d,t ;d _ our bytes/wd 403667' 220 03 0 00 000004 imul c,d ;c _ our no. of bytes 403670' 262 17 0 00 000005 pop p,e 403671' 202 03 0 10 000012 sambsz: movem c,fillby(h) 403672' 200 02 0 00 000010 move b,h 403673' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 15 PASIO MAC 7-Mar-81 20:52 pmap I/O - random access subttl pmap I/O - random access ;setpos 403674' 200 05 0 00 000004 dskspo: move e,d ;e _ suppress get flag 403675' 260 17 0 00 403722' pushj p,dskmov ;go where asked to 403676' 263 17 0 00 000000 popj p, ;error return 403677' 402 00 0 02 000027 posdon: setzm fillct(b) ;old transfers now irrelevant 403700' 332 01 0 02 000003 skipe a,filerr(b) ;clear eof unless due to real error 403701' 306 01 0 00 600220 cain a,iox4 403702' 254 00 0 00 403704' jrst .+2 ;if no error or eof, clear eof 403703' 254 00 0 00 403710' jrst posnoc ; other error, don't clear 403704' 200 00 0 02 000007 move t,filbad(b) 403705' 640 00 0 00 000001 trc t,1 403706' 202 00 0 02 000001 movem t,fileof(b) ;clear pascal eof 403707' 402 00 0 02 000003 setzm filerr(b) ;and error code 403710' 574 03 0 02 000032 posnoc: hlre c,filcnt(b) ;set up arg for binary get if needed 403711' 210 03 0 00 000003 movn c,c 403712' 332 00 0 02 000007 skpwrt ;don't read if open for write 403713' 322 05 1 02 000016 jumpe e,@filget(b) ;get 1st char unless suppressed 403714' 200 01 0 02 000032 move a,filcnt(b) ;new at new place 403715' 402 00 0 01 000000 setzm (a) 403716' 253 01 0 00 403715' aobjn a,.-1 403717' 200 01 0 02 000007 move a,filbad(b) ;1 if input, 0 if not 403720' 202 01 0 02 000002 movem a,fileol(b) ;dummy eol since nothing there 403721' 263 17 0 00 000000 popj p, ;dskmov - internal routine to move to new place 403722' 305 03 0 00 000000 dskmov: caige c,0 ;if less than zero 403723' 200 03 0 02 000012 move c,fillby(b) ;use end of file 403724' 261 17 0 00 000003 push p,c ;save desired byte 403725' 230 03 0 02 000026 idiv c,filbfs(b) ;c _ pages, d _ bytes off in page 403726' 200 00 0 00 000003 move t,c ;req. page goes in t 403727' 260 17 0 00 403267' pushj p,getfpg ;go to that page 403730' 254 00 0 00 403741' jrst dskspf ;failed - leave things unchanged 403731' 262 17 0 02 000013 pop p,filcby(b) ;we are now at requested place 403732' 200 01 0 02 000026 move a,filbfs(b) ;compute bytes left in page 403733' 274 01 0 00 000004 sub a,d 403734' 202 01 0 02 000034 movem a,filbct(b) ;and leave in counter ife klcpu,< ;[5] start movei t,^D36 ldb a,[point 6,filbfp(b),11] ;byte size idiv t,a ;t _ byte / wd move c,d idiv c,t ;c _ words, d _ bytes add c,filbfp(b) ;c _ pointer adjusted by words jumpe d,.+3 ;loop to adjust c by bytes ibp c sojg d,.-1 movem c,filbpt(b) ;store as current byte > ;ife klcpu ifn klcpu,< ;[5] end 403735' 133 04 0 02 000025 adjbp d,filbfp(b) ;get pointer to the requested place 403736' 202 04 0 02 000035 movem d,filbpt(b) > ;ifn klcpu 403737' 350 00 0 17 000000 aos (p) ;good (skip) return PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 15-1 PASIO MAC 7-Mar-81 20:52 pmap I/O - random access 403740' 263 17 0 00 000000 popj p, 403741' 262 17 0 17 000000 dskspf: pop p,(p) ;fail return, restore stack 403742' 263 17 0 00 000000 popj p, 403743' 200 01 0 02 000013 dskcpo: move a,filcby(b) 403744' 202 01 0 17 000001 movem a,1(p) ;just return current byte pt. 403745' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 16 PASIO MAC 7-Mar-81 20:52 actual I/O routines for text files on ascii devices subttl actual I/O routines for text files on ascii devices ;getchx is the normal ascii input routine 403746' 402 00 0 02 000002 getchx: setzm fileol(b) 403747' 550 01 0 02 000004 hrrz a,filjfn(b) 403750' 261 17 0 00 000002 push p,b 403751' 104 00 0 00 000050 getcx1: bin 403752' 320 16 0 00 403776' erjmp ioerb 403753' 322 02 0 00 403751' jumpe b,getcx1 ;ignore nulls 403754' 262 17 0 00 000001 pop p,a 403755' 250 02 0 00 000001 exch b,a ;a _ char, b _ fdb 403756' 405 01 0 00 000177 getchr: andi a,177 403757' 200 01 1 02 000010 move a,@filcht(b) 403760' 576 01 0 02 000002 hlrem a,fileol(b) 403761' 552 01 0 02 000043 hrrzm a,filcmp(b) 403762' 312 01 0 00 406756' came a,[xwd -1," "] ;if CR in standard Pascal mode 403763' 263 17 0 00 000000 popj p, 403764' 254 00 0 00 402163' jrst geteol ;then search for real EOL ;putchx is the normal ascii output 403765' 550 01 0 02 000004 putchx: hrrz a,filjfn(b) 403766' 261 17 0 00 000002 push p,b 403767' 200 02 0 02 000043 move b,filcmp(b) 403770' 104 00 0 00 000051 bout 403771' 320 17 0 00 405006' chkquo 403772' 320 16 0 00 403776' erjmp ioerb 403773' 262 17 0 00 000002 pop p,b 403774' 263 17 0 00 000000 popj p, 403775' 262 17 0 00 000003 ioerbc: pop p,c 403776' 262 17 0 00 000002 ioerb: pop p,b 403777' 254 00 0 00 405065' jrst ioerp PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput subttl I/O routines for tty and ttyoutput 000033 filttb==filst1 ;buffer for tty input ;note that this is a variable because it has to be reset during ; interrupt handling 404000' 375 00 0 02 000034 gettty: sosge filbct(b) ;type ahead left? 404001' 260 17 0 00 404005' pushj p,ttyadv ; no - get more 404002' 134 01 0 02 000035 ildb a,filbpt(b) ;get next char 404003' 322 01 0 00 404000' jumpe a,gettty ;ignore null 404004' 254 00 0 00 403756' jrst getchr ;standard ascii processor 404005' 560 01 0 02 000033 ttyadv: hrro a,filttb(b) ;get a new buffer 404006' 261 17 0 00 000002 push p,b 404007' 261 17 0 00 000003 push p,c ifn tenex,< ;[5] move b,[exp ttybsz] ;[5] count ifn sumex,< movei c,12 ;[7] break on LF pstin ;[5] pstin; [14] SUMEX/IMSSS only! ldb t,a ;[7] get terminator caie t,15 ;[7] cr? jrst ttyadn ;[7] no, normal movei t,12 ;[7] yes, add lf idpb t,a ;[7] subi b,1 ;[7] count it > ;ifn sumex ife sumex,< ife pa2040,< pushj p,rdstr ;[14] non SUMEX/IMSSS - simulate INTERLISP ed. printx assembling non sumex tty i/o routine > > ;ife sumex ttyadn: ;[7] > ;[5] ifn tenex ife tenex&<1-pa2040>,< ;[5] 404010' 400 03 0 00 000000 setz c, 404011' 200 02 0 00 406765' move b,[exp ttybsz!rd%top] ;break on tops-10 breaks ife pa2040,< 404012' 104 00 0 00 000523 rdtty 404013' 320 17 0 00 405006' chkquo 404014' 320 16 0 00 404113' erjmp ioecbp > ifn pa2040,< pushj p,$$rdtty## jump 16,ioecbp ;erjmp ioecbp > > ;[5] 404015' 550 02 0 00 000002 hrrz b,b ;loc. left in buffer 404016' 201 00 0 00 000371 movei t,ttybsz-1 ;total number avail (simulate sos) 404017' 274 00 0 00 000002 sub t,b ;adjust for locations left 404020' 262 17 0 00 000003 pop p,c 404021' 262 17 0 00 000002 pop p,b 404022' 202 00 0 02 000034 movem t,filbct(b) PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-1 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput 404023' 540 00 0 02 000033 hrr t,filttb(b) 404024' 505 00 0 00 440700 hrli t,440700 404025' 202 00 0 02 000035 movem t,filbpt(b) 404026' 263 17 0 00 000000 popj p, ;TTOCUR - output portion of TTY buffer before current position ; uses t,a ; assumes B is FCB ; returns column position of prev char in C, ILDB ptr to current char in T 404027' 540 00 0 02 000033 ttocur: hrr t,filttb(b) ;first put out the buffer up to cur pos 404030' 505 00 0 00 440700 hrli t,440700 ;t is byte ptr 404031' 400 03 0 00 000000 setz c, ;c is column counter 404032' 200 01 0 00 000000 ttocr2: move a,t ;a _ new copy of byte ptr 404033' 133 00 0 00 000001 ibp a ;consider new char 404034' 316 01 0 02 000035 camn a,filbpt(b) ;if it is cur char, we are done 404035' 254 00 0 00 404046' jrst ttocr1 ;begin safety - prevent infinite loop in case ptr somehow messed up 404036' 550 01 0 00 000000 hrrz a,t ;addr from byte ptr 404037' 275 01 0 00 000062 subi a,^D50 ;compare to start of buffer + 50 404040' 313 01 0 02 000033 camle a,filttb(b) ;still within buffer? 404041' 254 00 0 00 404046' jrst ttocr1 ;end safety 404042' 134 01 0 00 000000 ildb a,t ;else do a real advance to this char 404043' 340 03 0 00 000000 aoj c, ;and count it 404044' 104 00 0 00 000074 pbout 404045' 254 00 0 00 404032' jrst ttocr2 ;yes, loop 404046' 261 17 0 00 000002 ttocr1: push p,b 404047' 201 01 0 00 000101 movei a,.priou 404050' 104 00 0 00 000111 rfpos ;RH(b) _ position in line 404051' 332 00 0 00 000002 skipe b ;if not terminal, use counted C 404052' 550 03 0 00 000002 hrrz c,b ;use position in terminal line 404053' 262 17 0 00 000002 pop p,b 404054' 263 17 0 00 000000 popj p, ;TTYSHL - Show the entire current line, with an arrow under the ; current position. No sideeffects. ;expects b to be set up 404055' 261 17 0 00 000000 ttyshl: push p,t 404056' 261 17 0 00 000001 push p,a 404057' 261 17 0 00 000003 push p,c ;put out the line 404060' 104 00 0 00 000076 psout 404061' 260 17 0 00 404027' pushj p,ttocur ;put out start of line 404062' 200 01 0 00 000000 move a,t ;now put out cur and rest of line 404063' 104 00 0 00 000076 psout ;now put out a line with ^ under cur pos ;crlf unless old line ended in one 404064' 201 01 0 00 000101 movei a,.priou ;see where we are now on line 404065' 261 17 0 00 000002 push p,b 404066' 104 00 0 00 000111 rfpos ;probably retype ended in a CRLF 404067' 550 02 0 00 000002 hrrz b,b ;b _ current pos on line hrroi a,[asciz / 404070' 561 01 0 00 406766' /] 404071' 303 02 0 00 000001 caile b,1 ;if not at beginning PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-2 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput 404072' 104 00 0 00 000076 psout ; then do CRLF 404073' 262 17 0 00 000002 pop p,b ;spaces up to the right place 404074' 201 01 0 00 000040 movei a,40 ;now blanks up to cur pos 404075' 361 03 0 00 404100' ttshl4: sojl c,ttshl3 ;up to column shown in C 404076' 104 00 0 00 000074 pbout 404077' 254 00 0 00 404075' jrst ttshl4 ;put out the ^ 404100' 201 01 0 00 000136 ttshl3: movei a,"^" ;now caret under cur. pos 404101' 104 00 0 00 000074 pbout hrroi a,[asciz / 404102' 561 01 0 00 406766' /] 404103' 104 00 0 00 000076 psout ;and CRLF 404104' 262 17 0 00 000003 pop p,c 404105' 262 17 0 00 000001 pop p,a 404106' 262 17 0 00 000000 pop p,t 404107' 263 17 0 00 000000 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 404110' 260 17 0 00 404124' ttyfxl: pushj p,ttyini 404111' 201 01 0 00 000101 movei a,.priou 404112' 254 00 0 00 401751' jrst tryagn ifn tenex,< ife sumex,< ife pa2040,< ; non SUMEX/IMSSS tty routine...Similar to Sumex/IMSSS PSTIN, i.e. ; corrections by typing a "[" and reverse-echoing characters deleted ; from the string. First newly-typed character gets a "]" first: ; "this is a mispe[ep]spelling". However unlike the Sumex code, it ; does not put you into binary mode, and it uses the same breaks as ; RD%TOP, i.e. ^G, ^L, ^Z, ESC, CR, LF. ; This code is the result of several iterations. It was originally ; supplied by Sumex, fixed up by DFloodPage at BBN, and finally edited ; by Hedrick. ; AC1 contains the string pointer ; AC2 contains the maximum number of bytes to input ; AC0 holds line character count, won't delete if count=0 ; Note: The decrement bytepointer routine frequently sets ; Arithmetic Overflow. Thus, channel 6 is shut off ; during RDSTR, and reactivated afterwards ;Uses the following table to tell whether the terminal type is display. ;The user should make sure it is right for his site. if1, trmtab: exp 0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 trmmax=.-1-trmtab ;uses t,c. a and b are returned. Others preserved where used. PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-3 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput rdstr: push p,b ;save ac2 push p,e ;save ac5 push p,d ;save ac4 hlrz e,a ;get the left half of the pointer move d,a ;move the whole pointer to d to use cain e,777777 ;implicit bp? hrli d,440700 ;convert to standard bytepointer ;args now set up: ; t - free, will be count of char's seen, initialized below ; a - free ; b - count of free chars in buffer ; c - free, will be flag bits below, 200000 = echo on, 100000 = display ; d - byte pointer into buffer ; e - free ;now set up COC and mode word, saving old on stack move e,b ;save b in e movei a,101 ;get old COC word rfcoc push p,b ;save old COC push p,c tlz b,(3B3) ;clear echo for ^A tlz c,(3B1+3B7+3B9+3B11+3B13);clear echo for ^R, ^U, ^V, ^W, ^X sfcoc ;new COC rfmod ;get old RFMOD push p,b ;save old mode word ;We have to set break on punct because rubout is a punctuation char on tenex! trz b,77B23+3B29 ;new values for wakeup and mode tro b,16B23+1B29 ;all except alphanum, ASCII mode sfmod ;new mode gttyp caile b,trmmax ;legal terminal type? setz b, ;no - use 0 setz c, ;flags to zero skipe trmtab(b) ;except if display terminal tro c,100000 ;set display flag move b,e ;restore b push p,d ;stack is now: ; initial d ; mode ; COC, c on top ; saved d ; saved e ; initial b ;finish setting up AC's as described above: setz t, ;init count to 0 rdstr1: pbin ;get byte andi a,177 ;[clh] make 7-bit cain a,"V"-100 ;^V to quote jrst rdqte cain a,177 ;delete? jrst rddel PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-4 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput cail a,40 ;characters .ge. 40 are always OK jrst rdok ;This is just for speed ;It is a control character. We now test its special properties. cain a,"A"-100 ;^A = delete jrst rddel cain a,37 ;37 is EOL (quote it to get ^_) jrst rdeol caie a,"U"-100 ;^U and cain a,"X"-100 ;^X = delete line jrst rddell cain a,"R"-100 ;^R jrst rdreds ; redisplay line cain a,"W"-100 ;^W jrst rddlwd ; delete word movei e,1 ;now check terminators lsh e,(a) tdnn e,[xwd 001400,032200] ;null is right-most bit jrst rdok ;not a terminator jrst rdtrm ;is a terminator rdeol: movei a,15 ;treat as CRLF idpb a,d ;put down the CR soj b, ;adjust count movei a,12 ;and LF idpb a,d soj b, tlz c,400000 ;*clear delete bit, or it gets ;* integer overflow and crashes if you ;* hit control-U. jrst rdtrm1 rdok: aoj t, ;increment count idpb a,d ;put the byte into the string soje b,rdtrm1 ;if all bytes gone, leave jrst rdstr1 rdqte: pbin andi a,177 ;[clh] jrst rdok ;get a quoted character ;delete line rddell: cain t,0 ;at BOLN, nothing to do jrst [movei a,7 ;beep pbout jrst rdstr1] tlz c,400000 ;will start new line clean trne c,100000 ;handle display mode jrst rpdell hrroi a,[asciz / XXX /] psout ;tell him line is cleared rxdell: setz a, ;null for clearing line move d,0(p) ;reinit pointer setz t, ; count move b,-6(p) ; and char's free PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-5 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput jrst rdstr1 ;now go for new line ;display version of delete line rpdell: movei a,15 ;bare cr pbout jrst rxdell ;retype line rdreds: push p,t ;put null at the end of string setz t, ; here's the null move a,d ; here's the end of string idpb t,a ; put it there pop p,t ;and restore things trne c,100000 ;check display jrst rpreds hrroi a,[asciz / /] psout ;CRLF rxreds: move a,0(p) ;initial pointer to buffer psout ;now put it out jrst rdstr1 ;and go back for more ;display version of retype line rpreds: movei a,15 ;bare CR instead of CRLF pbout jrst rxreds ;delete word rddlwd: cain t,0 ;delete word, error at BOLN jrst [movei a,7 pbout jrst rdstr1] movei a,"_" ;echoes as backarrow trnn c,100000 ;if display, DECBP will delete pbout ;do it ;do first char always ldb a,d ;first char to be deleted pushj p,decbp ;start by deleting a char aoj b, ;and adjust counts soje t,rdstr1 ; if run out of char, done pushj p,isanum ;is thing we deleted alphanum? jrst rdstr1 ;no - we are finished ;do more as long as all alphanum (including first) rddlw2: ldb a,d ;delete any more? pushj p,isanum ;if alphanum, yes jrst rdstr1 ; not, done pushj p,decbp ;delete aoj b, ;adjust counts soje t,rdstr1 ; if run out, done jrst rddlw2 ;otherwise, go back for more isanum: caig a,"z" caige a,"0" popj p, ;null-(0 ; z)-177 caige a,"a" PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-6 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput caig a,"9" jrst yesanm ;0 - 9 ; a - z caig a,"Z" caige a,"A" popj p, ;9) - (A ; Z) - a( yesanm: aos (p) ;fall through on A - Z popj p, rddel: cain t,0 jrst [movei a,7 ;at "BOLN," don't do a delete pbout ; jrst rdstr1] trne c,100000 ;display mode? jrst rddel2 ;yes, skip this since DECBP deletes ldb a,d ;echo the preceding character pbout movei a,"\" ;and backslash pbout rddel2: pushj p,decbp ;decrement the bytepointer aoj b, ;take back that character soj t, ;and decrement the line count jrst rdstr1 ;get another byte rdtrm: idpb a,d ;the final byte for character .lt. 37 tlz c,400000 ;*clear delete bit, or it gets ;* integer overflow and crashes if you ;* hit control-U. soj b, ;read a byte, correct the count rdtrm1: move t,b ;save b to be returned in t ; a to be returned is in d setz a, ;stick a null at the end move b,d idpb a,b ;stack is now: ; initial d ; mode ; COC, c on top ; saved d ; saved e ; initial b movei a,400000 movsi b,(1b6) ;start restoring things from stack pop p,(p) ;not needed movei a,101 pop p,b sfmod ;mode pop p,c pop p,b sfcoc ;COC ;put in return values before we clobber where they are move b,t move a,d ;resume the restoration pop p,d ;ac's PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-7 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput pop p,e pop p,(p) ;not needed popj p, ;leave decbp: repeat 4, subi d,1 trnn c,100000 ;in display mode, also remove from screen popj p, ;here to move back on a screen push p,b push p,c push p,d ildb d,d ;get thing being deleted cail d,40 ;if printable, handle easily jrst decprt ;here for control character lsh d,1 ;multiply by 2, since 2 COC bits per word movei a,.priou rfcoc ;echo depends upon COC words lshc b,(d) ;shift COC bits to high order end of 2 tlnn b,600000 ;if zero, nothing to back over jrst decdon ; so done tlnn b,400000 ;if one, ^X jrst decctx ; so do ^X cain d,11 ;if tab jrst redisp ; I am lazy - redisplay the line tlnn b,200000 ;if two, unknown jrst redisp ; so redisplay cain d,33 ;if esc jrst decone ; one char jrst redisp ;else unknown, so redisplay ;here for printable char decprt: cain d,177 ;rubout is not printable jrst decdon ; so do nothing caig d,132 ;outside upper case caige d,101 jrst decone ;it is just one char movei a,.priou ;upper case - be sure we aren't mapping rfmod trnn b,tt%uoc jrst decone ;not mapping - one char only jrst dectwo ;mapping - two char's ;here for ^X type. Problem is that upper case when flagging is ^'A, etc. decctx: pushj p,backsp ;backspace for the ^ jrst redisp addi d,100 ;give us the upper case thing after the ^ jrst decprt ;now the char itself ;here when completely confused, to redisplay the line redisp: movei a,15 ;start fresh pbout setz b, ;null to put at end of string move a,(p) ;get d (current byte pointer) PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-8 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput idpb b,a ;put null next move a,-4(p) ;start of line psout jrst decdon ;now the simple action routines dectwo: pushj p,backsp jrst redisp decone: pushj p,backsp jrst redisp decdon: pop p,d pop p,c pop p,b popj p, ;here is the backspacer: backsp: movei a,.priou ;if at start of physical line, redisplay prev rfpos trnn b,777777 ;if zero, is at start popj p, ;redisplay needed movei a,.priou ;set for literal use of ^H rfcoc push p,b tlz b,(3B17) tlo b,(2B17) sfcoc hrroi a,[byte (7)10,40,10] ;bs,sp,bs psout pop p,b movei a,.priou ;retore coc sfcoc aos (p) popj p, > ;ife pa2040 > ;ife sumex > ;ifn tenex 404113' 262 17 0 00 000003 ioecbp: pop p,c 404114' 262 17 0 00 000002 pop p,b 404115' 105 17 0 00 777777 adjstk p,-1 404116' 254 00 0 00 405065' jrst ioerp 000042' reloc 000372 ttybsz==^D250 ;no of char's in buffer 000042' ttybuf: block ^D50 ;buffer itself 404117' reloc 404117' 200 01 0 02 000043 puttty: move a,filcmp(b) 404120' 104 00 0 00 000074 pbout 404121' 320 17 0 00 405006' chkquo 404122' 320 16 0 00 405065' erjmp ioerp PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 17-9 PASIO MAC 7-Mar-81 20:52 I/O routines for tty and ttyoutput 404123' 263 17 0 00 000000 popj p, 404124' 402 00 0 02 000034 ttyini: setzm filbct(b) ;this is done by breakin 404125' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 18 PASIO MAC 7-Mar-81 20:52 actual I/O for terminals openned as files subttl actual I/O for terminals openned as files ;on tenex, this routine is only used for the controlling terminal 404126' 375 00 0 02 000034 getcht: sosge filbct(b) 404127' 260 17 0 00 404143' pushj p,tdvadv 404130' 134 01 0 02 000035 ildb a,filbpt(b) 404131' 322 01 0 00 404126' jumpe a,getcht 404132' 306 01 0 00 000032 cain a,"Z"-100 ;control-Z? 404133' 254 00 0 00 402135' jrst simeof ;yes - is really eof 404134' 254 00 0 00 403756' jrst getchr ;device-dependent open routine 404135' 660 07 0 00 100000 tdvopn: tro g,of%wr ;need write priv's to do echo output 404136' 402 00 0 02 000034 setzm filbct(b) ;force read on first get 404137' 402 00 0 02 000024 setzm filter(b) ;no saved errors 404140' 201 01 0 00 000001 movei a,1 ;get a one page buffer 404141' 260 17 0 00 403546' pushj p,alcbuf 404142' 254 00 0 00 401303' jrst openfi 404143' tdvadv: ife tenex&<1-pa2040>,< ;[7] 404143' 332 00 0 02 000024 skipe filter(b) ;if any stored error 404144' 254 00 0 00 405644' jrst simerx ;do it and abort 404145' 261 17 0 00 406767' push p,[exp 4] ;construct arg block for texti - size 404146' 261 17 0 00 406770' push p,[exp rd%top!rd%jfn] 404147' 200 00 0 02 000004 move t,filjfn(b) 404150' 504 00 0 00 000000 hrl t,t 404151' 261 17 0 00 000000 push p,t 404152' 560 00 0 02 000015 hrro t,filbuf(b) ;place to put input 404153' 261 17 0 00 000000 push p,t 404154' 261 17 0 00 406771' push p,[exp 5000] ;no of char's allowed 404155' 201 01 0 17 777774 movei a,-4(p) ifn pa2040,< pushj p,$$texti## hrrzm a,filter(b) ;save error for simerr >;ifn pa2040 ife pa2040,< 404156' 104 00 0 00 000524 texti 404157' 320 17 0 00 405006' chkquo 404160' 320 17 0 00 404200' ercal txtier >;ife pa2040 404161' 201 00 0 00 004777 movei t,4777 ;no. of char's remaining 404162' 274 00 0 17 000000 sub t,(p) 404163' 105 17 0 00 777773 adjstk p,-5 > ;ife tenex ifn tenex&<1-pa2040>,< ;[7] begin push p,b push p,c hrro a,filbuf(b) ;place to put input move b,[exp 5000] ;count ifn sumex,< movei c,032012 ;break on ^Z, LF pstin ;[14] sumex/imsss line read PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 18-1 PASIO MAC 7-Mar-81 20:52 actual I/O for terminals openned as files ldb t,a ;get terminator caie t,15 ;cr? jrst tdvadn ;no, normal movei t,12 ;yes, add lf idpb t,a ; subi b,1 ;count it > ife sumex,< pushj p,rdstr ;[14] non-sumex simulation of line read > tdvadn: ; movei t,4777 ;no of char's remaining subi t,(b) pop p,c pop p,b > ;ifn tenex [7] ^^ 404164' 321 00 0 00 404143' jumpl t,tdvadv ;none there - try again or do error now 404165' 202 00 0 02 000034 movem t,filbct(b) ; (caller assumes we got at least 1) 404166' 540 00 0 02 000015 hrr t,filbuf(b) ;initial byte ptr 404167' 505 00 0 00 440700 hrli t,440700 404170' 202 00 0 02 000035 movem t,filbpt(b) 404171' 263 17 0 00 000000 popj p, 404172' 402 00 0 02 000034 setpt: setzm filbct(b) ;setpos (curpos is curpbx) 404173' 332 00 0 02 000024 skipe filter(b) ;activate stored errors 404174' 260 17 0 00 405645' pushj p,simerr 404175' 254 00 0 00 404406' jrst setpbx 404176' 105 17 0 00 777772 ioerp5: adjstk p,-6 ;note - 5 to restore stk, 1 to abort caller 404177' 254 00 0 00 405065' jrst ioerp 404200' 552 01 0 02 000024 txtier: hrrzm a,filter(b) ;save error for simerr 404201' 263 17 0 00 000000 popj p, ;TDOCUR - output portion of TTY buffer before current position ; uses t,a ; assumes B is FCB ; returns column position of prev char in C, ILDB ptr to current char in T 404202' 261 17 0 00 000002 tdocur: push p,b 404203' 261 17 0 00 000004 push p,d 404204' 261 17 0 00 000005 push p,e 404205' 540 00 0 02 000015 hrr t,filbuf(b) ;first put out the buffer up to cur pos 404206' 505 00 0 00 440700 hrli t,440700 ;t is byte ptr 404207' 550 01 0 02 000004 hrrz a,filjfn(b) ;a is jfn 404210' 400 03 0 00 000000 setz c, ;c is column counter 404211' 550 04 0 02 000015 hrrz d,filbuf(b) ;d _ end of buffer 404212' 271 04 0 00 001000 addi d,1000 404213' 200 05 0 02 000035 move e,filbpt(b) ;e _ byte pointer for end 404214' 200 02 0 00 000000 tdocr2: move b,t ;a _ new copy of byte ptr 404215' 133 00 0 00 000002 ibp b ;consider new char 404216' 316 02 0 00 000005 camn b,e ;if it is cur char, we are done 404217' 254 00 0 00 404227' jrst tdocr1 ;begin safety - prevent infinite loop in case ptr somehow messed up 404220' 550 02 0 00 000000 hrrz b,t ;addr from byte ptr PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 18-2 PASIO MAC 7-Mar-81 20:52 actual I/O for terminals openned as files 404221' 313 02 0 00 000004 camle b,d ;still within buffer? 404222' 254 00 0 00 404227' jrst tdocr1 ;end safety 404223' 134 02 0 00 000000 ildb b,t ;else do a real advance to this char 404224' 340 03 0 00 000000 aoj c, ;and count it 404225' 104 00 0 00 000051 bout 404226' 254 00 0 00 404214' jrst tdocr2 ;yes, loop 404227' 104 00 0 00 000111 tdocr1: rfpos ;RH(b) _ position in line 404230' 332 00 0 00 000002 skipe b ;if not terminal, use counted C 404231' 550 03 0 00 000002 hrrz c,b ;use position in terminal line 404232' 262 17 0 00 000005 pop p,e 404233' 262 17 0 00 000004 pop p,d 404234' 262 17 0 00 000002 pop p,b 404235' 263 17 0 00 000000 popj p, ;TDVSHL - Show the entire current line, with an arrow under the ; current position. No sideeffects. ;expects b to be set up 404236' 261 17 0 00 000000 tdvshl: push p,t 404237' 261 17 0 00 000001 push p,a 404240' 261 17 0 00 000002 push p,b 404241' 261 17 0 00 000003 push p,c ;put out the line 404242' 260 17 0 00 404202' pushj p,tdocur ;put out start of line 404243' 550 01 0 02 000004 hrrz a,filjfn(b) 404244' 200 02 0 00 000000 move b,t ;now put out cur and rest of line 404245' 200 00 0 00 000003 move t,c ;t _ position of ^ on line 404246' 400 03 0 00 000000 setz c, 404247' 104 00 0 00 000053 sout ;now put out a line with ^ under cur pos ;crlf unless old line ended in one 404250' 104 00 0 00 000111 rfpos ;probably retype ended in a CRLF 404251' 550 02 0 00 000002 hrrz b,b ;b _ current pos on line 404252' 307 02 0 00 000001 caig b,1 ;if not, crlf 404253' 254 00 0 00 404257' jrst tdvsh1 hrroi b,[asciz / 404254' 561 02 0 00 406766' /] 404255' 400 03 0 00 000000 setz c, 404256' 104 00 0 00 000053 sout 404257' tdvsh1: ;spaces up to the right place 404257' 201 02 0 00 000040 movei b,40 ;now blanks up to cur pos 404260' 361 00 0 00 404263' tdvsh4: sojl t,tdvsh3 ;up to column shown in t 404261' 104 00 0 00 000051 bout 404262' 254 00 0 00 404260' jrst tdvsh4 ;put out the ^ 404263' 201 02 0 00 000136 tdvsh3: movei b,"^" ;now caret under cur. pos 404264' 104 00 0 00 000051 bout hrroi b,[asciz / 404265' 561 02 0 00 406766' /] 404266' 400 03 0 00 000000 setz c, 404267' 104 00 0 00 000053 sout ;and CRLF 404270' 262 17 0 00 000003 pop p,c 404271' 262 17 0 00 000002 pop p,b PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 18-3 PASIO MAC 7-Mar-81 20:52 actual I/O for terminals openned as files 404272' 262 17 0 00 000001 pop p,a 404273' 262 17 0 00 000000 pop p,t 404274' 263 17 0 00 000000 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 404275' 260 17 0 00 404124' tdvfxl: pushj p,ttyini 404276' 550 01 0 02 000004 hrrz a,filjfn(b) 404277' 254 00 0 00 401751' jrst tryagn PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 19 PASIO MAC 7-Mar-81 20:52 line and page routines (all ascii modes) subttl line and page routines (all ascii modes) ;Note that getln is called by readln. Thus I class it as a high-level ; function and so abort the operation if eof is set. The low-level ; functions (get, put, etc.) will try to go on even if eof is set. 404300' 260 17 1 02 000016 getlx1: pushj p,@filget(b) 404301' 332 00 0 02 000001 getlnx: skipe fileof(b) ;stop after errors 404302' 263 17 0 00 000000 popj p, 404303' 337 00 0 02 000002 skipg fileol(b) 404304' 254 00 0 00 404300' jrst getlx1 404305' 254 00 1 02 000016 jrst @filget(b) 404306' 201 00 0 00 000015 putlnx: movei t,15 404307' 202 00 0 02 000043 movem t,filcmp(b) 404310' 260 17 1 02 000017 pushj p,@filput(b) 404311' 201 00 0 00 000012 movei t,12 404312' 202 00 0 02 000043 movem t,filcmp(b) 404313' 254 00 1 02 000017 jrst @filput(b) 404314' 201 00 0 00 000015 putpgx: movei t,15 404315' 202 00 0 02 000043 movem t,filcmp(b) 404316' 260 17 1 02 000017 pushj p,@filput(b) 404317' 201 00 0 00 000014 movei t,14 404320' 202 00 0 02 000043 movem t,filcmp(b) 404321' 254 00 1 02 000017 jrst @filput(b) PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 20 PASIO MAC 7-Mar-81 20:52 i/o routines for record files, sin/sout i/o used subttl i/o routines for record files, sin/sout i/o used ;args to getbx and putbx: ; b - fcb ; c - count of words to transfer 404322' 200 05 0 00 000002 getbx: move e,b ;record read - save fcb 404323' 550 01 0 05 000004 hrrz a,filjfn(e) ;source 404324' 541 02 0 05 000043 hrri b,filcmp(e) ;destination 404325' 505 02 0 00 444400 hrli b,444400 ;binary 404326' 202 03 0 05 000027 movem c,fillct(e) ;store count for error recov. and putx 404327' 210 03 0 00 000003 movn c,c ;count (negative means stop on count) 404330' 400 04 0 00 000000 setz d, 404331' 104 00 0 00 000052 sin 404332' 320 16 0 00 404350' erjmp ioerbx 404333' 263 17 0 00 000000 popj p, 404334' 200 05 0 00 000002 getxbx: move e,b ;similar to getbx, but continue old read 404335' 550 01 0 05 000004 hrrz a,filjfn(e) 404336' 541 02 0 05 000043 hrri b,filcmp(e) 404337' 505 02 0 00 444400 hrli b,444400 404340' 270 02 0 05 000027 add b,fillct(e) ;start after last record 404341' 202 03 0 05 000027 movem c,fillct(e) 404342' 274 03 0 05 000027 sub c,fillct(e) ;reduce count that much 404343' 210 03 0 00 000003 movn c,c 404344' 400 04 0 00 000000 setz d, 404345' 104 00 0 00 000052 sin 404346' 320 16 0 00 404350' erjmp ioerbx 404347' 263 17 0 00 000000 popj p, 404350' 272 03 0 05 000027 ioerbx: addm c,fillct(e) 404351' 200 04 0 00 000005 move d,e 404352' 254 00 0 00 405064' jrst ioer 404353' 200 05 0 00 000002 putbx: move e,b ;record write - save fcb 404354' 550 01 0 05 000004 putby: hrrz a,filjfn(e) ;source - entry for putx 404355' 541 02 0 05 000043 hrri b,filcmp(e) ;destination 404356' 505 02 0 00 444400 hrli b,444400 404357' 202 03 0 05 000027 movem c,fillct(e) ;count 404360' 210 03 0 00 000003 movn c,c ;make count negative 404361' 400 04 0 00 000000 setz d, 404362' 332 00 0 00 000003 skipe c ;[40] zero is special 404363' 104 00 0 00 000053 sout 404364' 320 17 0 00 405006' chkquo 404365' 320 16 0 00 404350' erjmp ioerbx 404366' 263 17 0 00 000000 popj p, 404367' 200 05 0 00 000002 putxbx: move e,b ;record rewrite 404370' 550 01 0 05 000004 hrrz a,filjfn(e) 404371' 104 00 0 00 000043 rfptr ;see where we are now 404372' 320 16 0 00 405063' erjrst eioer ;[7] 404373' 274 02 0 05 000027 sub b,fillct(e) ;get to beginning of record 404374' 104 00 0 00 000027 sfptr 404375' 320 16 0 00 405063' erjrst eioer ;[7] 404376' 200 03 0 05 000027 move c,fillct(e) ;size of record PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 20-1 PASIO MAC 7-Mar-81 20:52 i/o routines for record files, sin/sout i/o used 404377' 254 00 0 00 404354' jrst putby ;now put it out 404400' 200 04 0 00 000002 curpbx: move d,b ;get current byte no. 404401' 550 01 0 04 000004 hrrz a,filjfn(d) 404402' 104 00 0 00 000043 rfptr 404403' 320 16 0 00 405064' erjrst ioer ;[7] 404404' 202 02 0 17 000001 movem b,1(p) ;return value goes here 404405' 263 17 0 00 000000 popj p, 404406' 200 05 0 00 000004 setpbx: move e,d ;suppress get flag 404407' 200 04 0 00 000002 move d,b ;save fcb 404410' 550 01 0 04 000004 hrrz a,filjfn(d) 404411' 200 02 0 00 000003 move b,c ;place to go 404412' 104 00 0 00 000027 sfptr 404413' 320 16 0 00 405064' erjrst ioer ;[7] 404414' 200 02 0 00 000004 move b,d ;restore b for get routine 404415' 254 00 0 00 403677' jrst posdon ;common code to clear status and do get 404416' 260 17 0 00 401303' bxopn: pushj p,openfi 404417' 402 00 0 02 000027 bxini: setzm fillct(b) ;initialization for open 404420' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 21 PASIO MAC 7-Mar-81 20:52 i/o routines for tape - sinr/soutr i/o used subttl i/o routines for tape - sinr/soutr i/o used ;args to getbxr and putbxr: ; b - fcb ; c - count of words to transfer 404421' 200 05 0 00 000002 getbxr: move e,b ;record read - save fcb 404422' 550 01 0 05 000004 hrrz a,filjfn(e) ;source 404423' 541 02 0 05 000043 hrri b,filcmp(e) ;destination 404424' 505 02 0 00 444400 hrli b,444400 ;binary 404425' 202 03 0 05 000027 movem c,fillct(e) ;store count for error recov. and putx 404426' 200 00 0 00 000003 move t,c ;save requested count 404427' 210 03 0 00 000003 movn c,c ;count (negative means stop on count) 404430' 400 04 0 00 000000 setz d, 404431' 104 00 0 00 000531 sinr 404432' 320 16 0 00 404350' erjmp ioerbx 404433' 270 03 0 00 000000 add c,t ;get no. words actually read 404434' 202 03 0 05 000027 movem c,fillct(e) ;save as real count 404435' 263 17 0 00 000000 popj p, 404436' 200 05 0 00 000002 putbxr: move e,b ;record write - save fcb 404437' 550 01 0 05 000004 hrrz a,filjfn(e) ;source - entry for putx 404440' 541 02 0 05 000043 hrri b,filcmp(e) ;destination 404441' 505 02 0 00 444400 hrli b,444400 404442' 202 03 0 05 000027 movem c,fillct(e) ;count 404443' 210 03 0 00 000003 movn c,c ;make count negative 404444' 400 04 0 00 000000 setz d, 404445' 336 00 0 00 000003 skipn c ;[40] zero is special 404446' 541 02 0 00 406565' hrri b,[exp 0] ;[40] stop immediately 404447' 104 00 0 00 000532 soutr 404450' 320 17 0 00 405006' chkquo 404451' 320 16 0 00 404350' erjmp ioerbx 404452' 263 17 0 00 000000 popj p, 404453' 200 01 0 02 000027 lstrec: move a,fillct(b) ;get size of last record 404454' 202 01 0 17 000001 movem a,1(p) 404455' 263 17 0 00 000000 popj p, ;Here are the routines for handling text with SINR and SOUTR 404456' 375 00 0 02 000034 putcx: sosge filbct(b) ;write a character 404457' 254 00 0 00 404463' jrst ptcxer ;ran out of space in buffer - line too long 404460' 200 01 0 02 000043 move a,filcmp(b) 404461' 136 01 0 02 000035 idpb a,filbpt(b) 404462' 263 17 0 00 000000 popj p, 404463' 201 01 0 00 602234 ptcxer: movei a,iox20 ;illegal tape record size 404464' 202 01 0 02 000003 movem a,filerr(b) 404465' 254 00 0 00 405061' jrst ioerpx ;simulate I/O error 404466' 375 00 0 02 000034 getcx: sosge filbct(b) ;read a character 404467' 254 00 0 00 404477' jrst getcxl ;end of buffer - this is end of line 404470' 134 01 0 02 000035 getcxn: ildb a,filbpt(b) 404471' 405 01 0 00 000177 andi a,177 404472' 322 01 0 00 404466' jumpe a,getcx ;ignore nulls PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 21-1 PASIO MAC 7-Mar-81 20:52 i/o routines for tape - sinr/soutr i/o used 404473' 200 01 1 02 000010 move a,@filcht(b) 404474' 402 00 0 02 000002 setzm fileol(b) ;the only end of line is end of record 404475' 552 01 0 02 000043 hrrzm a,filcmp(b) 404476' 263 17 0 00 000000 popj p, ;GETCXL - here from GETCX when run out of chars in record. We simulate ; end of line, and set things so the next character read forces going ; to a new record. 404477' 201 01 0 00 404537' getcxl: movei a,getlx ;make the next GETCH get a new line 404500' 202 01 0 02 000016 movem a,filget(b) 404501' 201 01 0 00 000001 movei a,1 ;set EOL 404502' 202 01 0 02 000002 movem a,fileol(b) 404503' 201 01 0 00 000040 movei a,40 ;and call it a blank, as per Pascal std. 404504' 202 01 0 02 000043 movem a,filcmp(b) 404505' 263 17 0 00 000000 popj p, ;Here we have the routines to go to a new record. there is a special ;version for format F 404506' 261 17 0 00 000003 putlx: push p,c ;write the buffer 404507' 261 17 0 00 000002 push p,b 404510' 550 01 0 02 000004 hrrz a,filjfn(b) 404511' 210 03 0 02 000026 movn c,filbfs(b) ;compute number of bytes to dump 404512' 270 03 0 02 000034 add c,filbct(b) ;subtract number not actually used 404513' 200 02 0 02 000012 move b,filpbp(b) 404514' 336 00 0 00 000003 skipn c ;[40] zero is special 404515' 541 02 0 00 406565' hrri b,[exp 0] ;[40] stop immediately 404516' 104 00 0 00 000532 soutr 404517' 320 17 0 00 405006' chkquo 404520' 320 16 0 00 403330' erjmp badpag 404521' 262 17 0 00 000002 pop p,b 404522' 200 01 0 02 000026 move a,filbfs(b) ;reinitialize state 404523' 202 01 0 02 000034 movem a,filbct(b) 404524' 200 01 0 02 000025 move a,filbfp(b) 404525' 202 01 0 02 000035 movem a,filbpt(b) 404526' 262 17 0 00 000003 pop p,c 404527' 263 17 0 00 000000 popj p, ;PUTLXX - special version for format F - writes an exact line 404530' 201 01 0 00 000040 putlxx: movei a,40 ;put blanks until the record is full 404531' 337 03 0 02 000034 skipg c,filbct(b) ;space left? 404532' 254 00 0 00 404506' jrst putlx ;no - do output now 404533' 136 01 0 02 000035 idpb a,filbpt(b) ;yes - put in spaces 404534' 367 03 0 00 404533' sojg c,.-1 ;as long as there is space 404535' 402 00 0 02 000034 setzm filbct(b) ;now no space left 404536' 254 00 0 00 404506' jrst putlx ;do normal write 404537' 201 01 0 00 404466' getlx: movei a,getcx ;restore normal reader 404540' 202 01 0 02 000016 movem a,filget(b) 404541' 261 17 0 00 000003 push p,c 404542' 261 17 0 00 000002 push p,b 404543' 550 01 0 02 000004 hrrz a,filjfn(b) 404544' 210 03 0 02 000026 movn c,filbfs(b) 404545' 200 02 0 02 000012 move b,filpbp(b) 404546' 104 00 0 00 000531 sinr PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 21-2 PASIO MAC 7-Mar-81 20:52 i/o routines for tape - sinr/soutr i/o used 404547' 320 16 0 00 403330' erjmp badpag 404550' 262 17 0 00 000002 pop p,b 404551' 270 03 0 02 000026 add c,filbfs(b) ;compute actual number transferred ;[40] remove subi c,1 - code must work for empty lines 404552' 202 03 0 02 000034 movem c,filbct(b) 404553' 200 01 0 02 000025 move a,filbfp(b) 404554' 202 01 0 02 000035 movem a,filbpt(b) 404555' 262 17 0 00 000003 pop p,c 404556' 254 00 0 00 404466' jrst getcx ;[40] was jrst getcxn ;CHROPX - mode-specific open. This is bascially a version of ; CHROPN, the byte-mode open, except that it has to test for ; format F and use a special PUTLN routine. 404557' 332 00 0 02 000003 chropx: skipe filerr(b) ;byte mode I/O open 404560' 263 17 0 00 000000 popj p, ;no-op if error ;Here is the code that is always done ;The following is in fact just CHROPN 404561' 260 17 0 00 401303' pushj p,openfi ;now open it 404562' 260 17 0 00 405651' chrox1: pushj p,logopn ;compute logical parameters 404563' 200 00 0 02 000025 move t,filbfp(b) ;physical param's = logical ones 404564' 202 00 0 02 000012 movem t,filpbp(b) 404565' 200 00 0 02 000026 move t,filbfs(b) 404566' 202 00 0 02 000013 movem t,filpbs(b) ;This part sets up for special EOL handling because of the nature of this mode 404567' 550 00 0 02 000010 hrrz t,filcht(b) ;don't censor EOL char's, since they aren't EOL 404570' 306 00 0 00 402613' cain t,norchx ;if a char table that censors, change it 404571' 201 00 0 00 402171' movei t,norcht 404572' 306 00 0 00 403035' cain t,lcchx 404573' 201 00 0 00 402413' movei t,lccht 404574' 542 00 0 02 000010 hrrm t,filcht(b) ;put back correct table ;We have to "prime the pump" for reading. this mode is different from others ; because it will manufacture an EOL char when the buffer empties. So if ; we just start with an empty buffer, we get an initial EOL! 404575' 332 00 0 02 000007 skpwrt 404576' 260 17 0 00 404477' pushj p,getcxl ;if reading, init so the first GET reads ;The rest of this code is checking for writing a tape in format F, in which ; case we have to set up a special routine for PUTLN. ;Writing 404577' 332 00 0 02 000007 skpwrt ;if reading, no problem 404600' 263 17 0 00 000000 popj p, ;a tape 404601' 200 10 0 00 000002 move h,b ;save FCB 404602' 550 01 0 10 000004 hrrz a,filjfn(h) ;see if this is a tape 404603' 104 00 0 00 000117 dvchr 404604' 135 02 0 00 406772' ldb b,[point 9,b,17] ;get device type 404605' 302 02 0 00 000002 caie b,.dvmta ;if not tape, nothing to do 404606' 254 00 0 00 403525' jrst cpopjh ;exit, restoring B from H ;in format F ; Since we are writing we can't just look at the label. We have to ; predict whether it will be format F. It turns out that this will ; happen only if the tape is labelled and the user has specified ; ;FORMAT:F. ;labelled 404607' 261 17 0 00 406773' push p,[exp 3] ;place to put result PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 21-3 PASIO MAC 7-Mar-81 20:52 i/o routines for tape - sinr/soutr i/o used 404610' 261 17 0 00 406565' push p,[exp 0] 404611' 261 17 0 00 406565' push p,[exp 0] 404612' 550 01 0 10 000004 hrrz a,filjfn(h) 404613' 201 02 0 00 000050 movei b,.morli ;look at label 404614' 201 03 0 17 777776 movei c,-2(p) 404615' 104 00 0 00 000077 mtopr 404616' 320 16 0 00 404660' erjmp chroxx ;not labelled, exit restoring stack and B 404617' 200 01 0 17 777777 move a,-1(p) ;label type 404620' 306 01 0 00 000001 cain a,.ltunl ;if unlabelled, forget this stuff 404621' 254 00 0 00 404660' jrst chroxx ;not labelled, exit restoring stack and B ;the user has specified format F 404622' 561 01 0 17 777776 hrroi a,-2(p) ;put results in stack 404623' 402 00 0 17 777776 setzm -2(p) 404624' 550 02 0 10 000004 hrrz b,filjfn(h) 404625' 201 03 0 00 000200 movei c,js%at1 ;return attr 404626' 561 04 0 00 406774' hrroi d,[asciz /FORMAT/] 404627' 104 00 0 00 000030 jfns 404630' 320 16 0 00 404660' erjmp chroxx ;not format F, exit restoring stack and B 404631' 200 01 0 17 777776 move a,-2(p) 404632' 312 01 0 00 406776' came a,[asciz /F/] 404633' 254 00 0 00 404660' jrst chroxx ;not format F, exit restoring stack and B ;We now know that we will need the special format F PUTLN. We have to set ; up the record size, so it knows how much to fill. This is more complex ; than it sounds. Since the tape is being created, we can't just get the ; record size from the label. We have to predict what the monitor will ; decide on. This turns out to be the user's RECORD attribute if there is ; one, or the block size if not. ;the user's RECORD attribute 404634' 561 01 0 17 777776 hrroi a,-2(p) ;put rec size in stack 404635' 561 04 0 00 406777' hrroi d,[asciz /RECORD/] 404636' 104 00 0 00 000030 jfns 404637' 320 16 0 00 404646' erjmp chronr ;no record attribute, use default 404640' 561 01 0 17 777776 hrroi a,-2(p) 404641' 201 03 0 00 000012 movei c,^D10 404642' 104 00 0 00 000225 nin 404643' 320 16 0 00 404646' erjmp chronr ;odd - use default too 404644' 200 03 0 00 000002 move c,b 404645' 254 00 0 00 404652' jrst chrofr ;found record size ;the block size if there is not RECORD attribute 404646' 550 01 0 10 000004 chronr: hrrz a,filjfn(h) ;no record attr - use default 404647' 201 02 0 00 000015 movei b,.morrs 404650' 104 00 0 00 000077 mtopr 404651' 320 16 0 00 404660' erjmp chroxx ;can't find that way either, treat as not F ;here the above two cases join - we have the record size in C 404652' 313 03 0 10 000026 chrofr: camle c,filbfs(h) ;too big for buffer? 404653' 254 00 0 00 404663' jrst rectb ;record too big 404654' 202 03 0 10 000026 movem c,filbfs(h) ;use this instead of buffer size 404655' 202 03 0 10 000034 movem c,filbct(h) ;we start with a full buffer available 404656' 201 01 0 00 404530' movei a,putlxx ;get special PUT for format F 404657' 202 01 0 10 000021 movem a,filpln(h) ;exit, restoring stack and B 404660' 105 17 0 00 777775 chroxx: adjstk p,-3 404661' 200 02 0 00 000010 move b,h 404662' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 21-4 PASIO MAC 7-Mar-81 20:52 i/o routines for tape - sinr/soutr i/o used 404663' 105 17 0 00 777775 rectb: adjstk p,-3 ;record too big 404664' 200 02 0 00 000010 move b,h 404665' 254 00 0 00 404463' jrst ptcxer ;give error message ;LOGCLX - mode-specific closer - force the buffer 404666' 332 00 0 02 000007 logclx: skpwrt ;only if writing 404667' 263 17 0 00 000000 popj p, 404670' 200 01 0 02 000034 move a,filbct(b) ;anything in this buffer? 404671' 312 01 0 02 000026 came a,filbfs(b) 404672' 254 00 1 02 000021 jrst @filpln(b) ;yes - force it 404673' 263 17 0 00 000000 popj p, ;no 404674' 332 00 0 02 000007 loginx: skpwrt ;breakin 404675' 254 00 0 00 404477' jrst getcxl 404676' 200 01 0 02 000026 move a,filbfs(b) 404677' 202 01 0 02 000034 movem a,filbct(b) 404700' 200 01 0 02 000025 move a,filbfp(b) 404701' 202 01 0 02 000035 movem a,filbpt(b) 404702' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 22 PASIO MAC 7-Mar-81 20:52 magtape initialization subttl magtape initialization ;This is a device-dependent openning routine for magtape. It is used ;when the user leaves the I/O mode to us. Here is what we do ; format U, default, and unlabelled: "stream I/O": out: WRDOPN, in: CHROPN ; format F, D, and S: "record I/O": text:CHROPX, binary:BXOPN ;Unfortunately, we have to do the OPENF first in order to be able to ;read labels. ;In addition, if this is an output file and the user hasn't specified ;a format, we want to specify format U. This is somewhat harder than it ;sounds, since we can't specify the format after a GTJFN. However ;since format U will default to stream I/O, we just make it use WRDOPN, ;which uses 36 bits. This will get us format U by default. ;Input has to use CHROPN for format U in case the tape is foreign, in ;which case DEC is nice to us by forcing 8 bits internally. ;all three of the possible openning routines begin this way 404703' 332 00 0 02 000003 mtaopn: skipe filerr(b) 404704' 263 17 0 00 000000 popj p, ;might as well set up the stack now - everybody needs it 404705' 261 17 0 00 407001' push p,[exp 5] 404706' 261 17 0 00 406565' push p,[exp 0] 404707' 261 17 0 00 406565' push p,[exp 0] 404710' 261 17 0 00 406565' push p,[exp 0] 404711' 261 17 0 00 406565' push p,[exp 0] 404712' 200 10 0 00 000002 move h,b ;save B 404713' 332 00 0 02 000007 skpwrt ;if open for write 404714' 254 00 0 00 404742' jrst mtard ;not - no need to force 36 bits ;Part I - Check parameters for output file ;check unlabelled 404715' 550 01 0 10 000004 hrrz a,filjfn(h) 404716' 201 02 0 00 000050 movei b,.morli ;look at label 404717' 201 03 0 17 777774 movei c,-4(p) 404720' 104 00 0 00 000077 mtopr 404721' 320 16 0 00 404775' erjmp mtawrd ;unlabelled, force word 404722' 200 01 0 17 777775 move a,-3(p) ;get label type 404723' 306 01 0 00 000001 cain a,.ltunl 404724' 254 00 0 00 404775' jrst mtawrd ;unlabelled, force word ;check U or default 404725' 561 01 0 17 000000 hrroi a,0(p) ;put results in stack 404726' 402 00 0 17 000000 setzm 0(p) 404727' 550 02 0 10 000004 hrrz b,filjfn(h) 404730' 201 03 0 00 000200 movei c,js%at1 ;return attr 404731' 561 04 0 00 406774' hrroi d,[asciz /FORMAT/] 404732' 104 00 0 00 000030 jfns 404733' 320 16 0 00 404775' erjmp mtawrd ;unlabelled, force word ;some real format 404734' 200 01 0 17 000000 move a,(p) 404735' 316 01 0 00 407002' camn a,[asciz /U/] 404736' 254 00 0 00 404775' jrst mtawrd ;format U, force word ;here is the code for output files other than U - done separately from ;input since we don't want to do the MTOPR again PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 22-1 PASIO MAC 7-Mar-81 20:52 magtape initialization 404737' 200 02 0 00 000010 mtalog: move b,h ;openfi needs b 404740' 260 17 0 00 401303' pushj p,openfi ;open with logical byte size 404741' 254 00 0 00 404756' jrst mtaans ;now go handle ans type ;Part II - Check parameters for input file 404742' 260 17 0 00 401303' mtard: pushj p,openfi 404743' 550 01 0 10 000004 hrrz a,filjfn(h) ;now we can look at the label 404744' 201 02 0 00 000050 movei b,.morli 404745' 201 03 0 17 777774 movei c,-4(p) 404746' 104 00 0 00 000077 mtopr 404747' 320 16 0 00 404770' erjmp mtachr ;unlabelled, use CHROPN 404750' 200 01 0 17 777775 move a,-3(p) ;get label type 404751' 306 01 0 00 000001 cain a,.ltunl 404752' 254 00 0 00 404770' jrst mtachr ;unlabelled, use CHROPN 404753' 200 01 0 17 000000 move a,0(p) ;format 404754' 306 01 0 00 000125 cain a,"U" 404755' 254 00 0 00 404770' jrst mtachr ;format U, use CHROPN ;jrst mtaans ;Part III: ;Here are the exit routines. they set up the dispatch vector, and then ; go to the openning routine after the OPENF ;now we know we have format F, D, or S - handle it in some record mode 404756' 105 17 0 00 777773 mtaans: adjstk p,-5 ;[41] restore state 404757' 200 02 0 00 000010 move b,h 404760' 335 00 0 02 000032 skipge filcnt(b) 404761' 254 00 0 00 404765' jrst mtabx ;binary - BXOPN ;jrst .+1 ;text - use CHROPX 404762' 201 01 0 00 000007 movei a,fm%rec 404763' 260 17 0 00 400612' pushj p,setdsp ;set up dispatch block 404764' 254 00 0 00 404562' jrst chrox1 ;and go to CHROPX ;binary - use BXOPN 404765' 201 01 0 00 000007 mtabx: movei a,fm%rec 404766' 260 17 0 00 400612' pushj p,setdsp 404767' 254 00 0 00 404417' jrst bxini ;format U input - use CHROPN 404770' 105 17 0 00 777773 mtachr: adjstk p,-5 ;[41] 404771' 200 02 0 00 000010 move b,h ;restore FCB 404772' 201 01 0 00 000006 movei a,fm%chr 404773' 260 17 0 00 400612' pushj p,setdsp ;set up dispatch block 404774' 254 00 0 00 405721' jrst chrop1 ;format U output - use WRDPON 404775' 105 17 0 00 777773 mtawrd: adjstk p,-5 ;[41] 404776' 200 02 0 00 000010 move b,h ;restore FCB ;we haven't done OPENF yet, so we can just JRST to normal routine 404777' 201 01 0 00 000005 movei a,fm%wrd 405000' 260 17 0 00 400612' pushj p,setdsp ;set up dispatch block 405001' 254 00 0 00 405727' jrst wrdopn PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 23 PASIO MAC 7-Mar-81 20:52 i/o error routines subttl i/o error routines 405002' 200 04 0 00 000002 illfn: move d,b ;here for illegal function 405003' 201 01 0 00 601210 movei a,mtox1 ;"illegal function" (from mtopr) 405004' 202 01 0 04 000003 movem a,filerr(d) 405005' 254 00 0 00 405105' jrst erp. ;these errors are fatal 405002' unimp==illfn ;here for unimplemented function ife tenex,< ;chkquo - special thing designed to be used with ERCAL after a ;jsys that may write to disk. If quota is exceed, gives a ;message that looks just like the EXEC's, and retries the jsys ;if continued. 405006' 261 17 0 00 000001 quochk: push p,a 405007' 261 17 0 00 000002 push p,b 405010' 201 01 0 00 400000 movei a,400000 405011' 104 00 0 00 000012 geter 405012' 621 02 0 00 777777 tlz b,777777 ;b _ error code 405013' 302 02 0 00 601440 caie b,iox11 ;is it quota problem? 405014' 306 02 0 00 601107 cain b,pmapx6 405015' 254 00 0 00 405040' jrst isquot ;yes ;not a quota problem, do the next instruction, including erjmp/cal ;simulation. 405016' 200 01 0 17 777776 move a,-2(p) ;ret addr 405017' 554 02 0 01 000000 hlrz b,(a) ;next inst 405020' 306 02 0 00 320700 cain b,(erjmp) ;is erjmp? 405021' 254 00 0 00 405027' jrst dojmp 405022' 306 02 0 00 320740 cain b,(ercal) ;is ercal? 405023' 254 00 0 00 405032' jrst docal 405024' 262 17 0 00 000002 retba: pop p,b ;no, normal return 405025' 262 17 0 00 000001 pop p,a 405026' 263 17 0 00 000000 popj p, ;here are the erjmp/cal simulations 405027' 550 02 0 01 000000 dojmp: hrrz b,(a) ;address to go to 405030' 542 02 0 17 777776 hrrm b,-2(p) ;make us return there 405031' 254 00 0 00 405024' jrst retba 405032' 550 01 0 01 000000 docal: hrrz a,(a) ;address to call 405033' 262 17 0 00 000002 pop p,b 405034' 250 01 0 17 000000 exch a,(p) 405035' 105 17 0 00 777777 adjstk p,-1 ;we now have goto addr 1(p) 405036' 350 00 0 17 000000 aos (p) ;return after the next ercal 405037' 254 00 1 17 000001 jrst @1(p) ;this is pjrst ;here if it is a quota problem ; print a message, and then prepare to retry the instruction 405040' 561 01 0 00 406736' isquot: hrroi a,[asciz / Quota exceeded or disk full at /] 405041' 104 00 0 00 000313 esout 405042' 261 17 0 00 000003 push p,c 405043' 550 02 0 17 777775 hrrz b,-3(p) ;return addr 405044' 275 02 0 00 000002 subi b,2 ;the actual jsys addr 405045' 542 02 0 17 777775 hrrm b,-3(p) ;reset to return there 405046' 201 03 0 00 000010 movei c,10 ;base 8 405047' 201 01 0 00 000101 movei a,.priou 405050' 104 00 0 00 000224 nout 405051' 255 00 0 00 000000 jfcl ;not sure how to handle errors here hrroi a,[asciz / PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 23-1 PASIO MAC 7-Mar-81 20:52 i/o error routines [Find some space, then type CONTINUE] 405052' 561 01 0 00 406745' /] 405053' 104 00 0 00 000076 psout ; Finally we are ready to restore to the user's context and continue, ; is user types CONTINUE 405054' 262 17 0 00 000003 pop p,c ;restore ac's in case user does EXAMINE 405055' 262 17 0 00 000002 pop p,b 405056' 262 17 0 00 000001 pop p,a 405057' 104 00 0 00 000170 haltf ;let him delete some files 405060' 263 17 0 00 000000 popj p, > ;ife tenex 405061' 200 01 0 02 000003 ioerpx: move a,filerr(b) ;entry for those who already know the error 405062' 254 00 0 00 405073' jrst ioerp2 405063' 334 02 0 00 000005 eioer: skipa b,e ;entry if fcb is in e 405064' 200 02 0 00 000004 ioer: move b,d ;special entry if fcb is in d ;ioerp is the main error printer. it preserves b up 405065' 261 17 0 00 000002 ioerp: push p,b 405066' 201 01 0 00 400000 movei a,400000 ;use current process 405067' 104 00 0 00 000012 geter 405070' 550 01 0 00 000002 hrrz a,b ;error is in rh 405071' 262 17 0 00 000002 pop p,b 405072' 202 01 0 02 000003 movem a,filerr(b) ;and save new error 405073' 200 00 0 02 000007 ioerp2: move t,filbad(b) ;now set eof and eoln 405074' 202 00 0 02 000001 movem t,fileof(b) 405075' 202 00 0 02 000002 movem t,fileol(b) 405076' 331 00 0 02 000032 skipl filcnt(b) ;if ascii 405077' 402 00 0 02 000043 setzm filcmp(b) ;clear the component (read/ln needs this) 405100' 200 00 0 02 000006 move t,filflg(b) 405101' 302 01 0 00 600220 caie a,iox4 ;end of file always enabled 405102' 602 00 0 00 000002 trne t,fl%ioe ;user error handling? 405103' 263 17 0 00 000000 popj p, ;yes - let user handle it 405104' 200 04 0 00 000002 move d,b 405105' 260 17 0 00 405107' erp.:: pushj p,erp ;now put out message 405106' 254 00 0 00 405215' jrst endl ;and stop (fatal) 000001 spec==1 405107' erp..:: 405107' 561 01 0 00 406642' erp: hrroi a,[asciz / /] 405110' 104 00 0 00 000313 esout 405111' 201 01 0 00 000101 movei a,.priou ;now the error message 405112' 200 02 0 04 000003 move b,filerr(d) 405113' 505 02 0 00 400000 hrli b,400000 ;current process 405114' 400 03 0 00 000000 setz c, 405115' 104 00 0 00 000011 erstr 405116' 255 00 0 00 000000 jfcl 405117' 255 00 0 00 000000 jfcl 405120' 561 01 0 00 406643' hrroi a,[asciz / - /] ;now the file name 405121' 104 00 0 00 000076 psout 405122' 336 00 0 04 000004 skipn filjfn(d) ;[15] 405123' 263 17 0 00 000000 popj p, ;if no JFN, nothing to print 405124' 201 01 0 00 000101 movei a,.priou PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 23-2 PASIO MAC 7-Mar-81 20:52 i/o error routines 405125' 550 02 0 04 000004 hrrz b,filjfn(d) 405126' 400 03 0 00 000000 setz c, 405127' 104 00 0 00 000030 jfns 405130' erpdon: hrroi a,[asciz / 405130' 561 01 0 00 406766' /] 405131' 104 00 0 00 000076 psout 405132' 263 17 0 00 000000 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 405133' 261 17 0 00 000003 gotoc.: push p,c ;new P 405134' 261 17 0 00 000002 push p,b ;new O 405135' 550 05 0 00 000017 hrrz e,p ;release if leq e 405136' 550 06 0 00 000003 hrrz f,c ;and gt f 405137' 201 07 0 00 000412' movei g,blktab ;loop over blktab ;loop on blktab 405140' 200 02 0 07 000000 gotol: move b,(g) ;get the fcb addr there 405141' 313 02 0 00 000006 camle b,f ;if leq f 405142' 313 02 0 00 000005 camle b,e ;or g e 405143' 254 00 0 00 405151' jrst gotocn ; don't do anything with it ;here if the FCB is in area to be released 405144' 400 03 0 00 000000 setz c, ;yes - kill it 405145' 260 17 0 00 401563' pushj p,doclos 405146' 402 00 0 02 000040 setzm filtst(b) ;and indicate no longer valid 405147' 402 00 0 07 000000 setzm (g) ;clear table entry 405150' 476 00 0 07 777640 setom blklck-blktab(g) ;and release lock on it ;end of loop on blktab 405151' 315 07 0 00 000552' gotocn: camge g,lstblk 405152' 344 07 0 00 405140' 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 405153' 262 17 0 00 000016 pop p,o ;new O 405154' 262 17 0 00 000000 pop p,t ;new P 405155' 200 17 0 00 000000 move p,t 405156' 254 00 0 04 000000 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 405157' 261 17 0 00 000002 dispc.: push p,b ;save b and c 405160' 261 17 0 00 000003 push p,c 405161' 200 06 0 00 000002 move f,b ;f - lower limit 405162' 200 05 0 00 000002 move e,b 405163' 270 05 0 00 000003 add e,c ;e - upper limit 405164' 201 07 0 00 000412' movei g,blktab ;loop over blktab ;loop on blktab 405165' 200 02 0 07 000000 dispfl: move b,(g) ;get the fcb addr there 405166' 311 02 0 00 000006 caml b,f ;if lt f 405167' 311 02 0 00 000005 caml b,e ;or ge e 405170' 254 00 0 00 405176' jrst dispfn ; don't do anything with it PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 23-3 PASIO MAC 7-Mar-81 20:52 i/o error routines ;here if the FCB is in area to be released 405171' 400 03 0 00 000000 setz c, ;yes - kill it 405172' 260 17 0 00 401563' pushj p,doclos 405173' 402 00 0 02 000040 setzm filtst(b) ;and indicate no longer valid 405174' 402 00 0 07 000000 setzm (g) ;clear table entry 405175' 476 00 0 07 777640 setom blklck-blktab(g) ;and release lock on it ;end of loop on blktab 405176' 315 07 0 00 000552' dispfn: camge g,lstblk 405177' 344 07 0 00 405165' aoja g,dispfl ;if any more to look at, do so 405200' 262 17 0 00 000003 pop p,c 405201' 262 17 0 00 000002 pop p,b 405202' 263 17 0 00 000000 popj p, 405203' quit: 405203' 201 07 0 00 000412' end: movei g,blktab ;loop through all files 405204' 336 02 0 07 000000 endcl: skipn b,(g) ;get the fcb addr there 405205' 254 00 0 00 405213' jrst endcn ;nothing there, try next 405206' 400 03 0 00 000000 setz c, ;kill it 405207' 260 17 0 00 401563' pushj p,doclos ;close it 405210' 402 00 0 02 000040 setzm filtst(b) ;and indicate no longer valid 405211' 402 00 0 07 000000 setzm (g) ;clear table entry 405212' 476 00 0 07 777640 setom blklck-blktab(g) ;and release lock on it 405213' 315 07 0 00 000552' endcn: camge g,lstblk ;go to next, if any 405214' 344 07 0 00 405204' aoja g,endcl 405215' 104 00 0 00 000170 endl:: haltf ;that's all, folks hrroi a,[asciz /Can't continue 405216' 561 01 0 00 407003' /] 405217' 104 00 0 00 000313 esout 405220' 254 00 0 00 405215' jrst endl 405221' 200 00 0 02 000003 erstat: move t,filerr(b) ;let user see his error 405222' 202 00 0 17 000001 movem t,1(p) 405223' 263 17 0 00 000000 popj p, 405224' 336 00 0 02 000003 analys: skipn filerr(b) ;let him see error string 405225' 263 17 0 00 000000 popj p, 405226' 200 04 0 00 000002 move d,b 405227' 260 17 0 00 405107' pushj p,erp 405230' 263 17 0 00 000000 popj p, ;[43] - save the FCB in D, and change FILxxx(B) to FILxxx(D) 405231' 200 04 0 00 000002 clreof: move d,b ;[43] save FCB 405232' 336 01 0 04 000004 skipn a,filjfn(d) ;if no file involved, 405233' 254 00 0 00 405244' jrst clrOK ; then this is just bookkeeping 405234' 550 01 0 00 000001 hrrz a,a ;otherwise clear monitor's error bits 405235' 104 00 0 00 000024 gtsts 405236' 320 16 0 00 405065' erjmp ioerp ;if bad jfn, failed 405237' 325 02 0 00 405244' jumpge b,clrOK ;if file not open, nothing to do 405240' 627 02 0 00 001400 tlzn b,(gs%eof!gs%err) ;now reset with error bits off 405241' 254 00 0 00 405244' jrst clrOK ;no errors, nothing to do 405242' 104 00 0 00 000025 ststs 405243' 320 16 0 00 405064' erjrst ioer ;[7][43] 405244' 200 00 0 04 000007 clrOK: move t,filbad(d) ;set to normal eof 405245' 640 00 0 00 000001 trc t,1 ;reverse of bad status 405246' 202 00 0 04 000001 movem t,fileof(d) PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 23-4 PASIO MAC 7-Mar-81 20:52 i/o error routines 405247' 402 00 0 04 000003 setzm filerr(d) 405250' 200 02 0 00 000004 move b,d ;[43] ;[36] removed setting EOLN 405251' 263 17 0 00 000000 popj p, 405252' 200 04 0 00 000002 notop: move d,b ;where erp. wants it 405253' 201 01 0 00 600154 movei a,desx5 ;not open 405254' 202 01 0 04 000003 movem a,filerr(d) 405255' 254 00 0 00 405105' jrst erp. PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement subttl main file name getter for PROGRAM statement ;AC usage for getfn.: ; b - fcb ; c - pointer to name in ascii, length=10 always ; lh - flags for gtjfn ; h - used to save b ; garbarges all ac's except b ife tenex,< ;note - this routine is not reeentrant. Since it is used in the ; startup code, presumably it doesn't have to be. 405256' 260 17 0 00 405414' getfn.: pushj p,initb. ;always safe to init block at startup 405257' 200 10 0 00 000002 move h,b 405260' 200 04 0 03 000000 move d,(c) ;make up prompt 405261' 202 04 0 00 000124' movem d,fnprom 405262' 200 04 0 03 000001 move d,1(c) 405263' 202 04 0 00 000125' movem d,fnprom+1 ;C already has the "substantive" bits - make sure odd ones are off 405264' 621 03 0 00 000003 tlz c,(gj%fns!gj%sht) ;long form 405265' 502 03 0 00 000235' hllm c,getfna+.gjgen ;use flag bits 405266' 402 00 0 00 000234' setzm cmjfn 405267' 201 01 0 00 000226 movei a,bufsiz*5 ;init cmd block 405270' 202 01 0 00 000134' movem a,cmdblk+.cmcnt ;space left 405271' 402 00 0 00 000135' setzm cmdblk+.cminc ;char's not yet parsed 405272' 200 01 0 00 000132' move a,cmdblk+.cmbfp 405273' 202 01 0 00 000133' movem a,cmdblk+.cmptr ;next input ;main loop U 405274' 332 01 0 00 000000* getfn1: skipe a,cmcfn ;if any jfn gotten 405275' 104 00 0 00 000023 rljfn ;release it 405276' 320 16 0 00 405277' erjmp .+1 405277' 402 00 0 00 000234' setzm cmjfn ;now no jfn ;prompt 405300' 201 01 0 00 000127' movei a,cmdblk 405301' 201 02 0 00 405326' movei b,iniblk ;prompt 405302' 104 00 0 00 000544 comnd 405303' 320 16 0 00 405342' erjmp getfer 405304' 603 02 0 00 200000 tlne b,(cm%nop) ;error? 405305' 254 00 0 00 405342' jrst getfer ;yes - message and try again ;get file name 405306' 201 01 0 00 000127' movei a,cmdblk 405307' 201 02 0 00 405332' movei b,filblk ;file name 405310' 104 00 0 00 000544 comnd 405311' 320 16 0 00 405342' erjmp getfer 405312' 603 02 0 00 200000 tlne b,(cm%nop) ;error? 405313' 254 00 0 00 405342' jrst getfer ;yes - message and try again 405314' 552 02 0 00 000234' hrrzm b,cmjfn ;remember JFN in case have to close it 405315' 202 02 0 10 000004 movem b,filjfn(h) ;and put in FCB ;confirm 405316' 201 01 0 00 000127' movei a,cmdblk 405317' 201 02 0 00 405336' movei b,cfmblk ;confirm 405320' 104 00 0 00 000544 comnd PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-1 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement 405321' 320 16 0 00 405342' erjmp getfer 405322' 603 02 0 00 200000 tlne b,(cm%nop) ;error? 405323' 254 00 0 00 405342' jrst getfer ;yes - message and try again ;exit 405324' 200 02 0 00 000010 move b,h 405325' 263 17 0 00 000000 popj p, 405326' 014000 000000 iniblk: <.cmini>B8 405327' 000 00 0 00 000000 z 405330' 000 00 0 00 000000 z 405331' 000 00 0 00 000000 z 405332' 006000 000000 filblk: <.cmfil>B8 405333' 000 00 0 00 000000 z 405334' 000 00 0 00 000000 z 405335' 000 00 0 00 000000 z 405336' 010000 000000 cfmblk: <.cmcfm>B8 405337' 000 00 0 00 000000 z 405340' 000 00 0 00 000000 z 405341' 000 00 0 00 000000 z 000124' reloc 000124' fnprom: block 2 ;file name 000126' 040 072 040 000 000 asciz / : / 000127' 000000 405274' cmdblk: getfn1 ;reparse to loop 000130' 000100 000101 xwd .priin,.priou ;jfn's 000131' 777777 000124' xwd -1,fnprom ;^R 000132' 777777 000140' xwd -1,cmdbuf ;start of buffer 000133' 000 00 0 00 000000 z ;next to parse 000134' 000 00 0 00 000000 z ;left 000135' 777777 000176' xwd -1,atbuf ;atom buf 000136' 000000 000036 exp bufsiz ;size of atom buf 000137' 000000 000235' exp getfna ;addr of gtjfn arg 000036 bufsiz==^D30 000140' cmdbuf: block bufsiz 000176' atbuf: block bufsiz 000234' cmjfn: block 1 ;jfn needs releasing 000235' 000 00 0 00 000000 getfna: z ;gen 000236' 000100 000101 xwd .priin,.priou ;jfn's 000237' 000 00 0 00 000000 z ;dev 000240' 000 00 0 00 000000 z ;dir 000241' 000 00 0 00 000000 z ;name 000242' 000 00 0 00 000000 z ;ext 000243' 000 00 0 00 000000 z ;pro 000244' 000 00 0 00 000000 z ;acct 000245' 000 00 0 00 000000 z ;jfn to use 000246' 400000 000003 exp g1%rnd!3 ;extra flags,,how many extra args 000247' 000 00 0 00 000000 z ;this will get value of .JBFF 000250' 000 00 0 00 000000 z ;infinite size PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-2 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement 000251' 000 00 0 00 000000 z 405342' reloc 405342' 201 01 0 00 406642' getfer: movei a,[asciz / /] 405343' 104 00 0 00 000313 esout ;give ?, etc. 405344' 201 01 0 00 000101 movei a,.priou ;now error message 405345' 525 02 0 00 400000 hrloi b,400000 405346' 400 03 0 00 000000 setz c, 405347' 104 00 0 00 000011 erstr 405350' 255 00 0 00 000000 jfcl 405351' 255 00 0 00 000000 jfcl hrroi a,[asciz / 405352' 561 01 0 00 406766' /] 405353' 104 00 0 00 000076 psout 405354' 254 00 0 00 405274' jrst getfn1 405355' getfhl: hrroi a,[asciz / One of the following: 405355' 561 01 0 00 407007' File spec for the PASCAL file /] 405356' 104 00 0 00 000076 psout 405357' 201 01 0 00 000101 movei a,.priou ;print the file name 405360' 561 02 0 00 000004 hrroi b,d 405361' 211 03 0 00 000012 movni c,12 405362' 104 00 0 00 000053 sout hrroi a,[asciz / 405363' 561 01 0 00 407024' Carriage return to use default, /] 405364' 104 00 0 00 000076 psout ;Now give him the right default 405365' 302 10 0 00 000000* caie h,input## 405366' 306 10 0 00 000000* cain h,output## 405367' 254 00 0 00 405375' jrst getfh1 405370' 201 01 0 00 000101 movei a,.priou 405371' 561 02 0 00 000004 hrroi b,d 405372' 211 03 0 00 000012 movni c,12 405373' 104 00 0 00 000053 sout 405374' 254 00 0 00 405377' jrst getfh2 405375' 561 01 0 00 407034' getfh1: hrroi a,[asciz /your terminal/] 405376' 104 00 0 00 000076 psout 405377' getfh2: hrroi a,[asciz / 405377' 561 01 0 00 406766' /] 405400' 104 00 0 00 000076 psout 405401' 254 00 0 00 405274' jrst getfn1 ;here for default (TTY: for INPUT and OUTPUT, else filename) 405402' 200 01 0 00 000235' getfdf: move a,getfna ;flags user specified 405403' 661 01 0 00 000001 tlo a,(gj%sht) ;but short form 405404' 621 01 0 00 000006 tlz a,(gj%xtn!gj%fns) ;file spec as string 405405' 561 02 0 00 000004 hrroi b,d 405406' 302 10 0 00 405365* caie h,input## 405407' 306 10 0 00 405366* cain h,output## 405410' 561 02 0 00 407037' hrroi b,[asciz /TTY:/] 405411' 104 00 0 00 000020 gtjfn U 405412' 254 00 0 00 000000* jrst getfe1 U 405413' 254 00 0 00 000000* jrst getfnx ;done, return jfn and exit PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-3 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement > ;ife tenex ifn tenex,< getfn.: pushj p,initb. ;always init block at startup move h,b setzm filflg(b) ;clear temp bit move d,(c) ;d,e,f _ asciz prompt message move e,1(c) move f,[asciz / : /] hllz g,c ;g _ gtjfn flags getfn1: hrroi a,d ;prompt psout move a,g move b,[xwd .priin,.priou] gtjfn jrst getfer getfnx: movem a,filjfn(h) move b,h popj p, getfer: cain a,gjfx34 ;? typed jrst getfhl ;print help cain a,gjfx33 ;no name? - treat as default jrst getfdf getfe1: movei a,[asciz / /] esout ;give ?, etc. movei a,.priou ;now error message hrloi b,400000 setz c, erstr jfcl jfcl hrroi a,[asciz / /] psout jrst getfn1 getfhl: hrroi a,[asciz / One of the following: File spec for the PASCAL file /] psout movei a,.priou ;print the file name hrroi b,d movni c,12 sout hrroi a,[asciz / Carriage return to use default, /] psout ;Now give him the right default caie h,input## cain h,output## jrst getfh1 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-4 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement movei a,.priou hrroi b,d movni c,12 sout jrst getfh2 getfh1: hrroi a,[asciz /your terminal/] psout getfh2: hrroi a,[asciz / /] psout jrst getfn1 ;here for default (TTY: for INPUT and OUTPUT, else filename) getfdf: move a,g ;flags user specified tlo a,(gj%sht) ;but short form tlz a,(gj%xtn!gj%fns) ;file spec as string hrroi b,d caie h,input## cain h,output## hrroi b,[asciz /TTY:/] gtjfn jrst getfe1 jrst getfnx ;done, return jfn and exit > ;ifn tenex ;initb. - make file control block be fresh and clean ; b - addr of fcb ;saves all ac's 405414' 261 17 0 00 000001 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 405415' 505 01 0 00 777640 hrli a,-blklen ;aobjn word for searching block table 405416' 541 01 0 00 000252' hrri a,blklck ;we are actually searching table of locks 405417' 352 00 0 01 000000 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 405420' 253 01 0 00 405417' aobjn a,.-1 ;failed, try again 405421' 325 01 0 00 405440' jumpge a,initbf ;failed to find an index location 405422' 202 02 0 01 000140 movem b,blktab-blklck(a) ;found it, save block addr 405423' 201 01 0 01 000140 movei a,blktab-blklck(a) ;and update high-water mark 405424' 313 01 0 00 000552' camle a,lstblk 405425' 202 01 0 00 000552' movem a,lstblk ;init the block 405426' 505 01 0 00 405442' initbc: hrli a,protob ;blt prototype block to it 405427' 540 01 0 00 000002 hrr a,b 405430' 251 01 0 02 000043 blt a,filcmp(b) 405431' 201 01 0 02 000043 movei a,filcmp(b) ;now initializations that depend upon address 405432' 202 01 0 02 000000 movem a,filptr(b) 405433' 202 01 0 02 000032 movem a,filcnt(b) ;don't have info to set up LH yet PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-5 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement 405434' 262 17 0 00 000001 pop p,a 405435' 263 17 0 00 000000 popj p, ;init.b is a special entry for the compiler's use 405436' 261 17 0 00 000001 init.b: push p,a 405437' 254 00 0 00 405426' jrst initbc 405440' 260 17 0 00 400145' initbf: pushj p,blktbe ;print error message 405441' 254 00 0 00 405426' jrst initbc ;init the block anyway if he says to ;prototype block 405442' 000000 000000 protob: exp 0 ;FILPTR== 0 ;pointer to filcmp 405443' 000000 000000 exp 0 ;FILEOF== 1 ;input: 0 == normal state ; 1 == eof or error ;output:1 == normal state ; 0 == error 405444' 000000 000000 exp 0 ;FILEOL== 2 405445' 000000 000000 exp 0 ;FILERR== 3 ;RH - last error no, LH - enabled 405446' 000000 000000 exp 0 ;filjfn==4 ;jfn 405447' 000000 000000 exp 0 ;filspc==5 ;pointer to block with file spec in it 405450' 000000 000000 exp 0 ;filflg==6 ;flags 405451' 000000 000001 exp 1 ;filbad==7 ;contents to set fileof to if error 405452' 000000 402613' exp norchx ;filcht==10 ;pointer to character mapping table 405453' 000000 000000 exp 0 ;fils11==11 405454' 000000 000000 exp 0 ;fils12==12 405455' 000000 000000 exp 0 ;fils13==13 405456' 000000 000000 exp 0 ;fillts==14 405457' 000000 000000 exp 0 ;filbuf==15 ;buffer for paged files: ;LH == # of pages, RH == addr of first word ;filr11 through filr99 must be contiguous ;filr11==16 ;first routine 405460' 000000 405252' exp notop ;filget==16 ;routine for GET 405461' 000000 405252' exp notop ;filput==17 ;routine for PUT 405462' 000000 405252' exp notop ;filgln==20 ;routine for GETLN 405463' 000000 405252' exp notop ;filpln==21 ;routine for PUTLN 405464' 000000 000000 exp 0 ;filclo==22 ;device-dependent close 405465' 000000 401306' exp unop+filr99+1 ;filr99==23 ;pointer to other routines 405466' 000000 000000 exp 0 ;fils15==24 ;another state variable 405467' 000000 000000 exp 0 ;fils16==25 405470' 000000 000000 exp 0 ;fils17==26 405471' 000000 000000 exp 0 ;fils20==27 405472' 000000 000000 exp 0 ;fils21==30 405473' 000000 000000 exp 0 ;FILLNR==31 ;IF ASCII MODE - LINENR 405474' 000000 000000 exp 0 ;FILCNT==32 ;LH== neg size of component ; if text file: zero ;test sign bit of this loc to see if an ASCII file ;RH== ADDRESS OF FIRST WORD IN COMPONENT 405475' 000000 000000 exp 0 ;filst1==33 ;state variables for special I/O modes 405476' 000000 000000 exp 0 ;filst2==34 405477' 000000 000000 exp 0 ;filst3==35 405500' 000000 000000 exp 0 ;filst4==36 405501' 000000 000000 exp 0 ;filst5==37 405502' 000000 314157 exp 314157 ;filtst==40 ;should be 314157 if file is open 405503' 000000 000000 exp 0 ;filind==41 ;location in index 405504' 000000 000000 exp 0 ;42 - spare PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 24-6 PASIO MAC 7-Mar-81 20:52 main file name getter for PROGRAM statement 405505' 000000 000000 exp 0 ;FILCMP==43 ;FIRST WORD OF COMPONENT ;ttypr. - do initial get for INPUT 405506' 550 01 0 00 000000# ttypr.: hrrz a,input##+filjfn 405507' 104 00 0 00 000117 dvchr ;see if a tty 405510' 135 03 0 00 406772' ldb c,[point 9,b,17] ;dev type field 405511' 302 03 0 00 000012 caie c,.dvtty ;if not tty, forget it 405512' 254 00 0 00 405517' jrst ttyprg 405513' 550 01 0 00 000000# hrrz a,input+filjfn hrroi b,[asciz /[INPUT, end with ^Z: ] 405514' 561 02 0 00 407040' /] 405515' 400 03 0 00 000000 setz c, 405516' 104 00 0 00 000053 sout 405517' 201 02 0 00 405406* ttyprg: movei b,input## 405520' 254 00 0 00 401530' jrst getch PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 25 PASIO MAC 7-Mar-81 20:52 buffered I/O - text routines subttl buffered I/O - text routines 000012 filpbp==fils12 ;physical buffer byte pointer 000013 filpbs==fils13 ;physical buffer size 000024 filter==fils15 ;place to store defered error ;These routines do ildb/idpb from a one page buffer, which is filled/ ; emptied by sin/sout. It is a bit confusing because the I/O is ; often done in 36 bit mode, for efficiency. thus physical buffer ; size is the number of 36 bit bytes in the buffer when you are in ; this "word mode", and the number of logical bytes when in normal ; "character mode". Also, physical buffer byte pointer points to ; the beginning of the buffer, having a byte size of 36 in word mode, ; and the logical byte size in charcter mode. These routines are ; inefficient for mag tape when the record size is much less than ; a page, as proper overlapping of I/O and computation requires our ; buffer to be near the record size or smaller. 405521' 375 00 0 02 000034 putchb: sosge filbct(b) ;write a character 405522' 260 17 0 00 405555' pushj p,wrtbuf ;put out the buffer 405523' 200 01 0 02 000043 move a,filcmp(b) 405524' 136 01 0 02 000035 idpb a,filbpt(b) 405525' 263 17 0 00 000000 popj p, 405526' 375 00 0 02 000034 getchb: sosge filbct(b) ;read a character 405527' 260 17 0 00 405602' pushj p,reabuf ;fill the buffer 405530' 134 01 0 02 000035 getcb1: ildb a,filbpt(b) ;;entry for wrdlts 405531' 200 00 0 02 000014 move t,fillts(b) ;line number test bit 405532' 612 00 1 02 000035 tdne t,@filbpt(b) 405533' 254 00 0 00 405544' jrst getbln ;saw a line number 405534' 405 01 0 00 000177 andi a,177 405535' 322 01 0 00 405526' jumpe a,getchb ;ignore nulls 405536' 200 01 1 02 000010 move a,@filcht(b) 405537' 576 01 0 02 000002 hlrem a,fileol(b) 405540' 552 01 0 02 000043 hrrzm a,filcmp(b) 405541' 312 01 0 00 406756' came a,[xwd -1," "] ;CR is standard Pascal mode 405542' 263 17 0 00 000000 popj p, 405543' 254 00 0 00 402163' jrst geteol ;get "real" EOLN 405544' 200 00 1 02 000035 getbln: move t,@filbpt(b) 405545' 202 00 0 02 000031 movem t,fillnr(b) 405546' 350 00 0 02 000035 aos filbpt(b) 405547' 211 00 0 00 000005 movni t,5 405550' 273 00 0 02 000034 addb t,filbct(b) 405551' 325 00 0 00 405526' jumpge t,getchb 405552' 260 17 0 00 405602' pushj p,reabuf 405553' 133 00 0 02 000035 ibp filbpt(b) 405554' 254 00 0 00 405526' jrst getchb PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 26 PASIO MAC 7-Mar-81 20:52 buffered I/O - buffer advance routines subttl buffered I/O - buffer advance routines 405555' 261 17 0 00 000003 wrtbuf: push p,c ;write the buffer 405556' 261 17 0 00 000002 push p,b 405557' 550 01 0 02 000004 hrrz a,filjfn(b) 405560' 210 03 0 02 000013 movn c,filpbs(b) 405561' 200 02 0 02 000012 move b,filpbp(b) 405562' 332 00 0 00 000003 skipe c ;[40] zero is special 405563' 104 00 0 00 000053 sout 405564' 320 17 0 00 405006' chkquo 405565' 320 16 0 00 405576' erjmp ioebcp 405566' 262 17 0 00 000002 pop p,b 405567' 200 01 0 02 000026 move a,filbfs(b) ;reinitialize state 405570' 275 01 0 00 000001 subi a,1 ;sos already done 405571' 202 01 0 02 000034 movem a,filbct(b) 405572' 200 01 0 02 000025 move a,filbfp(b) 405573' 202 01 0 02 000035 movem a,filbpt(b) 405574' 262 17 0 00 000003 pop p,c 405575' 263 17 0 00 000000 popj p, 405576' 262 17 0 00 000002 ioebcp: pop p,b 405577' 262 17 0 00 000003 ioecp: pop p,c 405600' 105 17 0 00 777777 adjstk p,-1 ;abort caller 405601' 254 00 0 00 405065' jrst ioerp 405602' 332 00 0 02 000024 reabuf: skipe filter(b) ;fill the buffer - delayed error? 405603' 254 00 0 00 405644' jrst simerx ;yes - pretend it happened now 405604' 261 17 0 00 000003 push p,c 405605' 261 17 0 00 000002 push p,b 405606' 550 01 0 02 000004 hrrz a,filjfn(b) 405607' 210 03 0 02 000013 movn c,filpbs(b) 405610' 200 02 0 02 000012 move b,filpbp(b) 405611' 104 00 0 00 000052 sin 405612' 320 16 0 00 405623' erjmp saverr ;store error for later 405613' 262 17 0 00 000002 pop p,b 405614' 200 01 0 02 000026 move a,filbfs(b) 405615' 275 01 0 00 000001 subi a,1 405616' 202 01 0 02 000034 movem a,filbct(b) 405617' 200 01 0 02 000025 move a,filbfp(b) 405620' 202 01 0 02 000035 movem a,filbpt(b) 405621' 262 17 0 00 000003 pop p,c 405622' 263 17 0 00 000000 popj p, ;We have to delay errors and activate them after the user has seen any ; characters that have been returned. Otherwise EOF would come too ; soon. Note that the code assumes (implicitly) that reabuf returns ; something. So if no bytes have been gotten at all, we have to do ; the error now - can't delay it. 405623' 262 17 0 00 000002 saverr: pop p,b 405624' 200 00 0 02 000026 move t,filbfs(b) ;t _ logical bytes per transfer byte 405625' 230 00 0 02 000013 idiv t,filpbs(b) 405626' 220 03 0 00 000000 imul c,t ;c _ - logical bytes not transferred 405627' 270 03 0 02 000026 add c,filbfs(b) ;c _ bytes transferrred 405630' 322 03 0 00 405577' jumpe c,ioecp ;[27] none - immediate error 405631' 275 03 0 00 000001 subi c,1 ;caller has done sos PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 26-1 PASIO MAC 7-Mar-81 20:52 buffered I/O - buffer advance routines 405632' 202 03 0 02 000034 movem c,filbct(b) 405633' 200 01 0 02 000025 move a,filbfp(b) 405634' 202 01 0 02 000035 movem a,filbpt(b) ;otherwise normal init. 405635' 201 01 0 00 400000 movei a,400000 ;save error code for simerr 405636' 200 03 0 00 000002 move c,b ;save b ever jsys 405637' 104 00 0 00 000012 geter 405640' 250 02 0 00 000003 exch b,c ;c _ error code, fcb back in b 405641' 552 03 0 02 000024 hrrzm c,filter(b) 405642' 262 17 0 00 000003 pop p,c 405643' 263 17 0 00 000000 popj p, 405644' 105 17 0 00 777777 simerx: adjstk p,-1 ;abort caller 405645' 200 00 0 02 000024 simerr: move t,filter(b) ;activate delayed error 405646' 202 00 0 02 000003 movem t,filerr(b) ;put in real error place 405647' 402 00 0 02 000024 setzm filter(b) ;not delayed anymore 405650' 254 00 0 00 405061' jrst ioerpx ;and pretend we just saw it PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 27 PASIO MAC 7-Mar-81 20:52 buffered I/O - open and close subttl buffered I/O - open and close 405651' 602 07 0 00 200000 logopn: trne g,of%rd ;common openning 405652' 606 07 0 00 100000 trnn g,of%wr ;if read and write, can't do it 405653' 254 00 0 00 405655' jrst .+2 ;only one, OK 405654' 254 00 0 00 405002' jrst illfn 405655' 201 00 0 00 405002' movei t,illfn ;make wrong direction illegal (or he 405656' 336 00 0 02 000007 skprea ;writing? (might not get the error 405657' 202 00 0 02 000016 movem t,filget(b) ;read illegal (until fnished the 405660' 332 00 0 02 000007 skpwrt ;reading? (buffer) 405661' 202 00 0 02 000017 movem t,filput(b) 405662' 135 01 0 00 406760' ldb a,[fl%buf!filflg(b)] ;number of buffers user wants 405663' 307 01 0 00 000000 caig a,0 ;must be between 1 and 36 405664' 201 01 0 00 000001 movei a,1 ;if 0, use default 405665' 303 01 0 00 000044 caile a,^D36 ;if too big, use maximum 405666' 201 01 0 00 000044 movei a,^D36 405667' 200 00 0 00 000001 move t,a ;now have pages per buffer - get words 405670' 242 00 0 00 000011 lsh t,^D9 ;t _ words in buffer 405671' 202 00 0 02 000013 movem t,filpbs(b) ;filpbs _ words in buffer ;caller may reset this to bytes in buffer if that is what he wants 405672' 260 17 0 00 403546' pushj p,alcbuf ;# pages is arg to alcbuf, in A 405673' 135 00 0 00 406757' ldb t,[point 6,g,5] ;logical byte size 405674' 242 00 0 00 000030 lsh t,^D24 ;make byte pointer 405675' 661 00 0 00 440000 tlo t,440000 ;to beginning of word 405676' 540 00 0 02 000015 hrr t,filbuf(b) ;at buffer 405677' 202 00 0 02 000025 movem t,filbfp(b) ;store as logical bufer start 405700' 402 00 0 02 000035 setzm filbpt(b) ;assume nothing in buffer 405701' 336 00 0 02 000007 skprea ;if writing, give a full buffer 405702' 202 00 0 02 000035 movem t,filbpt(b) 405703' 201 00 0 00 000044 movei t,^D36 405704' 135 01 0 00 406757' ldb a,[point 6,g,5] ;computer buffer size in bytes 405705' 230 00 0 00 000001 idiv t,a ;t _ bytes per word 405706' 220 00 0 02 000013 imul t,filpbs(b) ;t _ bytes in buffer 405707' 202 00 0 02 000026 movem t,filbfs(b) ;store as logical size 405710' 402 00 0 02 000034 setzm filbct(b) 405711' 336 00 0 02 000007 skprea ;if writing, give a full buffer 405712' 202 00 0 02 000034 movem t,filbct(b) 405713' 402 00 0 02 000024 setzm filter(b) 405714' 402 00 0 02 000027 setzm fillct(b) 405715' 263 17 0 00 000000 popj p, 405716' 332 00 0 02 000003 chropn: skipe filerr(b) ;byte mode I/O open 405717' 263 17 0 00 000000 popj p, ;no-op if error 405720' 260 17 0 00 401303' pushj p,openfi 405721' 260 17 0 00 405651' chrop1: pushj p,logopn ;compute logical parameters 405722' 200 00 0 02 000025 move t,filbfp(b) ;physical param's = logical ones 405723' 202 00 0 02 000012 movem t,filpbp(b) 405724' 200 00 0 02 000026 move t,filbfs(b) 405725' 202 00 0 02 000013 movem t,filpbs(b) 405726' 263 17 0 00 000000 popj p, 405727' 332 00 0 02 000003 wrdopn: skipe filerr(b) ;word mode I/O open 405730' 263 17 0 00 000000 popj p, 405731' 260 17 0 00 405651' pushj p,logopn 405732' 200 00 0 02 000015 move t,filbuf(b) ;physical param's use 36 bit bytes PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 27-1 PASIO MAC 7-Mar-81 20:52 buffered I/O - open and close 405733' 505 00 0 00 444400 hrli t,444400 405734' 202 00 0 02 000012 movem t,filpbp(b) 405735' 621 07 0 00 770000 tlz g,770000 405736' 661 07 0 00 440000 tlo g,440000 ;set 36 bit bytes ;filpbs is left as set by logopn - words in buffer 405737' 254 00 0 00 401303' jrst openfi ifn srisw,< ;[23] ;This is part of the SRI kludge. See DSKLTS for an explanation of the ; reason for the kludge. ;device-dependent code to examine the first word to see if line-numbered. ; This code is mainly for the use of magtape. Since it is fairly common ; there to open the file, set parameters, and then do the first read, we ; have to wait and do the actual test at the first read. Thus this routine ; temporarily changes FILGET to call a routine that tests the first ; word, restores FILGET to the right thing, and then calls it. For the ; disk we have to do the actual test at open time, because somebody might ; do SETPOS before the first real. But for disk it is safe because one ; can do the test without any sideeffects. We tried BIN then BKJFN, but ; due to a monitor bug that doesn't work for tape. wrdlts: movei t,wrdgtt ;[22] special get that does a test first movem t,filget(b) ;[22] booby-trap FILGET popj p, ;[22] Special routine called for the first GETCH on the file, to see if line ;[22] numbered. The order in which things are done in this routine is a bit ;[22] more critical than it looks, in order to make error handling work. wrdgtt: movei t,getchb ;[22] restore normal reader movem t,filget(b) ;[22] pushj p,reabuf ;[22] get first buffer in move a,filbpt(b) ;[22] pointer to first byte ibp a ;[22] but expected to do ILDB move t,(a) ;[22] now have first word of buffer push p,c ;[22] comlts uses t,a,c,d push p,d ;[22] pushj p,comlts ;[22] pop p,d ;[22] pop p,c ;[22] jrst getcb1 ;[22] now continue with normal code > ;[23] ifn srisw 405740' 332 00 0 02 000007 logclo: skpwrt ;force buffers 405741' 263 17 0 00 000000 popj p, ;reading - none 405742' 200 00 0 02 000035 move t,filbpt(b) ;zero rest of last word ;magic code to clear rest of word. The offset field in the byte ; ponter now continas no. of bits from the right to be clered, ; so we use a new byte ptr with no offset and this as the size. 405743' 621 00 0 00 007700 tlz t,007700 405744' 510 01 0 00 000000 hllz a,t 405745' 242 01 0 00 777772 lsh a,-6 405746' 500 00 0 00 000001 hll t,a 405747' 400 01 0 00 000000 setz a, ;cler them 405750' 137 01 0 00 000000 dpb a,t PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 27-2 PASIO MAC 7-Mar-81 20:52 buffered I/O - open and close 405751' 200 00 0 02 000026 move t,filbfs(b) ;compute no. of bytes to put out 405752' 230 00 0 02 000013 idiv t,filpbs(b) ;t _ bytes / transfer byte 405753' 200 01 0 00 000000 move a,t ;a _ bytes / transfer byte 405754' 200 00 0 02 000026 move t,filbfs(b) ;t _ bytes used 405755' 274 00 0 02 000034 sub t,filbct(b) ;t _ bytes remaining 405756' 322 00 0 00 400177' jumpe t,cpopj ;if none - done 405757' 230 00 0 00 000001 idiv t,a ;t _ transfer bytes remaining 405760' 332 00 0 00 000001 skipe a ;round up 405761' 271 00 0 00 000001 addi t,1 405762' 261 17 0 00 000003 push p,c 405763' 261 17 0 00 000002 push p,b 405764' 210 03 0 00 000000 movn c,t ;make sin arg block 405765' 550 01 0 02 000004 hrrz a,filjfn(b) 405766' 200 02 0 02 000012 move b,filpbp(b) 405767' 332 00 0 00 000003 skipe c ;[40] zero is special 405770' 104 00 0 00 000053 sout 405771' 320 17 0 00 405006' chkquo 405772' 320 16 0 00 405576' erjmp ioebcp ;abort caller 405773' 262 17 0 00 000002 pop p,b 405774' 262 17 0 00 000003 pop p,c 405775' 200 00 0 02 000025 move t,filbfp(b) ;set up to make more possible 405776' 202 00 0 02 000035 movem t,filbpt(b) 405777' 200 00 0 02 000026 move t,filbfs(b) 406000' 202 00 0 02 000034 movem t,filbct(b) 406001' 263 17 0 00 000000 popj p, 406002' 260 17 0 00 405740' setpb: pushj p,logclo ;setpos (curpos is curpbx) 406003' 260 17 0 00 406005' pushj p,logini 406004' 254 00 0 00 404406' jrst setpbx 406005' 336 00 0 02 000007 logini: skprea ;breakin 406006' 263 17 0 00 000000 popj p, ;no-op on write 406007' 402 00 0 02 000034 setzm filbct(b) 406010' 402 00 0 02 000027 setzm fillct(b) 406011' 332 00 0 02 000024 skipe filter(b) ;if saved error 406012' 260 17 0 00 405645' pushj p,simerr ;activate it 406013' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 28 PASIO MAC 7-Mar-81 20:52 buffered I/O - routines for record I/O subttl buffered I/O - routines for record I/O ;The following routines set up C to indicate the desired ; transfer, and then call getblp or putblp, which simulate ; sin and sout. If an I/O error occurs, getblp or putblp ; will return with c as at the point of error. Thus the ; caller may have some adjustments to do. ;get 406014' 202 03 0 02 000027 getb: movem c,fillct(b) ;assume no. transferred = no. requested 406015' 210 03 0 00 000003 movn c,c ;make up aobjn word 406016' 504 03 0 00 000003 hrl c,c ;lh(c) _ no. to transfer 406017' 541 03 0 02 000043 hrri c,filcmp(b) ;rh(c) _ starting loc to transfer 406020' 260 17 0 00 406046' pushj p,getblp ;sin 406021' 574 03 0 00 000003 hlre c,c ;c _ - no. left untransferred 406022' 272 03 0 02 000027 addm c,fillct(b) ;adjust assumption 406023' 263 17 0 00 000000 popj p, ;put 406024' 202 03 0 02 000027 putb: movem c,fillct(b) 406025' 210 03 0 00 000003 movn c,c 406026' 504 03 0 00 000003 hrl c,c 406027' 541 03 0 02 000043 hrri c,filcmp(b) 406030' 260 17 0 00 406054' pushj p,putblp ;sout 406031' 574 03 0 00 000003 hlre c,c 406032' 272 03 0 02 000027 addm c,fillct(b) 406033' 263 17 0 00 000000 popj p, ;getx 406034' 200 04 0 00 000003 getxb: move d,c ;requested upper limit 406035' 274 03 0 02 000027 sub c,fillct(b) ;c _ no. needed this time 406036' 210 03 0 00 000003 movn c,c ;make aobjn word 406037' 504 03 0 00 000003 hrl c,c 406040' 541 03 0 02 000043 hrri c,filcmp(b) 406041' 270 03 0 02 000027 add c,fillct(b) ;adjust by no. already done 406042' 260 17 0 00 406046' pushj p,getblp ;sin 406043' 574 03 0 00 000003 hlre c,c 406044' 272 03 0 02 000027 addm c,fillct(b) 406045' 263 17 0 00 000000 popj p, ;Here are the sin/sout simulations. Note that if there is ; en I/O error, ioebcp will abort the routine. ; In that case c will be left negative, and the caller (above) ; will do the right thing. ;sin 406046' 375 00 0 02 000034 getblp: sosge filbct(b) ;sin simulation 406047' 260 17 0 00 405602' pushj p,reabuf 406050' 134 01 0 02 000035 ildb a,filbpt(b) 406051' 202 01 0 03 000000 movem a,(c) 406052' 253 03 0 00 406046' aobjn c,getblp 406053' 263 17 0 00 000000 popj p, ;sout 406054' 375 00 0 02 000034 putblp: sosge filbct(b) ;sout simulation PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 28-1 PASIO MAC 7-Mar-81 20:52 buffered I/O - routines for record I/O 406055' 260 17 0 00 405555' pushj p,wrtbuf 406056' 200 01 0 03 000000 move a,(c) 406057' 136 01 0 02 000035 idpb a,filbpt(b) 406060' 253 03 0 00 406054' aobjn c,putblp 406061' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 29 PASIO MAC 7-Mar-81 20:52 initialization subttl initialization 406062' 265 01 0 00 406064' pasin.: jsp a,pasif. ;[6] for old programs, new ones use pasif. 406063' 263 17 0 00 000000 popj p, ;[6] 406064' 200 07 0 00 000001 pasif.: move g,a ;[6] save return address 406065' 200 06 0 00 000002 move f,b ;save flag for checking 406066' 554 05 0 00 000000* hlrz e,.jbsa## ;get 1st above low seg 406067' 275 05 0 00 000001 subi e,1 ;adjust to page boundary 406070' 660 05 0 00 000777 tro e,777 ;we assume .jbff is always even page 406071' 271 05 0 00 000001 addi e,1 406072' 506 05 0 00 406066* hrlm e,.jbsa ;and put back adjusted value 406073' 311 05 0 00 400013* clrlop: caml e,.jbff## ;now clear everything up to .jbff 406074' 254 00 0 00 406105' jrst clrdon 406075' 474 01 0 00 000000 seto a, ;unmap the page 406076' 200 02 0 00 000005 move b,e 406077' 242 02 0 00 777767 lsh b,-9 ;make page no. 406100' 505 02 0 00 400000 hrli b,400000 ;this process 406101' 400 03 0 00 000000 setz c, 406102' 104 00 0 00 000056 pmap 406103' 271 05 0 00 001000 addi e,1000 ;now go to next page 406104' 254 00 0 00 406073' jrst clrlop 406105' 554 05 0 00 406072* clrdon: hlrz e,.jbsa ;get back adjusted top of code 406106' 202 05 0 00 406073* movem e,.jbff ;use for .jbff 406107' 104 00 0 00 000147 reset 406110' 402 00 0 00 000633' setzm izer1 ;zero interrupt data area 406111' 200 00 0 00 407045' move t,[xwd izer1,izer1+1] 406112' 251 00 0 00 000640' blt t,izer99 406113' 402 00 0 00 000561' setzm chntb. ;reinitialize interrupt control blocks 406114' 200 00 0 00 407046' move t,[xwd chntb.,chntb.+1] 406115' 251 00 0 00 000624' blt t,chntb.+^D35 406116' 200 00 0 00 407047' move t,[xwd 1,ovrflw] 406117' 202 00 0 00 000567' movem t,chntb.+6 406120' 202 00 0 00 000570' movem t,chntb.+7 406121' 200 00 0 00 407050' move t,[xwd 1,pdltrp] 406122' 202 00 0 00 000572' movem t,chntb.+^D9 406123' 201 01 0 00 400000 movei a,400000 ;turn on interrupts 406124' 200 02 0 00 407051' move b,[xwd levtab,chntb.] 406125' 104 00 0 00 000125 sir ;set up vector 406126' 205 02 0 00 000400 movsi b,(1b9) ;[4] pdl overflow 406127' 332 00 0 00 000006 skipe f ;[4] ignore arith. if not checking 406130' 661 02 0 00 006000 tlo b,(1b6!1b7) ;[4] arith. overflow 406131' 104 00 0 00 000131 aic ;turn on conditions 406132' 104 00 0 00 000126 eir ;turn on system ;if any files are left open, we clear filtst, to indicate that they ;need reinitialization 406133' 201 01 0 00 000412' movei a,blktab ;loop through all files 406134' 332 02 0 01 000000 pasin1: skipe b,(a) ;get the fcb addr there 406135' 402 00 0 02 000040 setzm filtst(b) ;and indicate no longer valid 406136' 402 00 0 01 000000 setzm (a) ;clear table entry 406137' 315 01 0 00 000552' camge a,lstblk ;go to next, if any PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 29-1 PASIO MAC 7-Mar-81 20:52 initialization 406140' 344 01 0 00 406134' aoja a,pasin1 406141' 402 00 0 00 000552' setzm lstblk ;now nothing in use 406142' 476 00 0 00 000252' setom blklck ;restore all to unlocked 406143' 200 01 0 00 407052' move a,[xwd blklck,blklck+1] 406144' 251 01 0 00 000411' blt a,blklck+blklen-1 ;here we are going to set the frepag bit table to all 1's to indicate all ; pages are free. GETPG. checks for overlap with heap, which is below ; the code, so we won't run into the high seg. After setting to all 1's, ; we then remove pages below .jbff, i.e. the low seg. 406145' 476 00 0 00 000000' pasin2: setom frepag ;indicate all 512 pages free 406146' 200 00 0 00 407053' move t,[xwd frepag,frepag+1] 406147' 251 00 0 00 000015' blt t,frepag+15 ;clear 14 words 406150' 205 00 0 00 776000 movsi t,776000 ;and 10 bits 406151' 202 00 0 00 000016' movem t,frepag+16 406152' 200 02 0 00 406106* move b,.jbff## ;now clear everything below .JBFF 406153' 242 02 0 00 777767 lsh b,-11 ;get page number. b is # of pages to be clear 406154' 231 02 0 00 000044 idivi b,44 ;b _ words to be cleared, c _ bits 406155' 361 02 0 00 406162' sojl b,pasin3 ;no words, just do bits 406156' 402 00 0 00 000000' setzm frepag ;b _ words-1 to be cleared 406157' 322 02 0 00 406162' jumpe b,pasin3 ;one word only, do bits 406160' 200 00 0 00 407053' move t,[xwd frepag,frepag+1] 406161' 251 00 0 02 000000' blt t,frepag(b) ;clear words ;all full words cleared, b _ # words cleared - 1 406162' 322 03 0 00 406167' pasin3: jumpe c,pasin4 ;if no bits to clear, ignore 406163' 205 00 0 00 400000 movsi t,400000 ;make mask for c bits 406164' 210 03 0 00 000003 movn c,c 406165' 240 00 0 03 000001 ash t,1(c) ;t _ xxx000, c bits on 406166' 412 00 0 02 000001' andcam t,frepag+1(b) ;clear these bits in next word 406167' 402 00 0 00 000000# pasin4: setzm tty##+1 406170' 402 00 0 00 000000# setzm tty##+filbct 406171' 200 00 0 00 407054' move t,[xwd tty##+1,tty##+2] 406172' 251 00 0 00 000000# blt t,tty##+filr11-1 406173' 402 00 0 00 000000# setzm ttyout##+1 406174' 200 00 0 00 407055' move t,[xwd ttyout##+1,ttyout##+2] 406175' 251 00 0 00 000000# blt t,ttyout##+filr11-1 406176' 200 00 0 00 407056' move t,[xwd ttynt,tty##+filr11] ;copy special tty routines into tty 406177' 251 00 0 00 000000# blt t,tty##+filr99 406200' 200 00 0 00 407057' move t,[xwd ttynt,ttyout##+filr11] ;and ttyout 406201' 251 00 0 00 000000# blt t,ttyout##+filr99 406202' 350 00 0 00 000000# aos tty##+fileol 406203' 350 00 0 00 000000# aos tty##+filbad 406204' 350 00 0 00 000000# aos ttyout##+fileof 406205' 200 00 0 00 406617' move t,[ascii /-----/] 406206' 202 00 0 00 000000# movem t,tty##+fillnr 406207' 202 00 0 00 000000# movem t,ttyout##+fillnr 406210' 201 00 0 00 000042' movei t,ttybuf 406211' 202 00 0 00 000000# movem t,tty##+filttb 406212' 201 00 0 00 314157 movei t,314157 ;magic indicating a valid file 406213' 202 00 0 00 000000# movem t,tty##+filtst 406214' 202 00 0 00 000000# movem t,ttyout##+filtst 406215' 402 00 0 00 000000* SETZM AVAIL## 406216' 402 00 0 00 000000# SETZM AVAIL+1 406217' 402 00 0 00 000000* SETZM BEGMEM## 406220' 402 00 0 00 000000* SETZM ENDMEM## PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 29-2 PASIO MAC 7-Mar-81 20:52 initialization 406221' 254 00 0 07 000000 jrst (g) ;[6] return 000252' reloc 000140 blklen==140 ;there are only 100 jfn's possible 000252' blklck: block blklen 000412' blktab: block blklen 000552' lstblk: block 1 ;still in low segment PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 30 PASIO MAC 7-Mar-81 20:52 error trapping subttl error trapping ;still in low segment intern chntb.,oldpc. 000553' 000000 000556' levtab: .+3 000554' 000000 000557' .+3 000555' 000000 000560' .+3 000556' oldpc.: block 3 000561' chntb.: block 6 ;0 - 5 000567' 000001 406222' xwd 1,ovrflw ;6 000570' 000001 406222' xwd 1,ovrflw ;7 000571' block 1 ;[4] 8 000572' 000001 406261' xwd 1,pdltrp ;[4] 9 000573' block ^D32 ;[4] 10-35 406222' reloc 406222' ovrflw: ;This routine is taken from forots, more or less 000100 000000 fxu==1b11 ;floating underflow 040000 000000 fov==1b3 ;some floating pt. error 000040 000000 ndv==1b12 ;some division by zero 406222' 105 17 0 00 000003 adjstk p,3 ;[3] just for safety, as sometimes use above stack 406223' 261 17 0 00 000000 push p,t ;[3] save ac's so we can restore 406224' 261 17 0 00 000001 push p,a ;[3] 406225' 200 00 0 00 000556' move t,oldpc. 406226' 550 01 0 00 000000 hrrz a,t ;the error pc 406227' 301 01 0 00 000000* cail a,safbeg## ;in runtime 406230' 303 01 0 00 000000* caile a,safend## 406231' 254 00 0 00 406233' jrst .+2 406232' 254 00 0 00 406245' jrst ignore 406233' 315 15 0 00 406152* camge n,.jbff## ;in debugger 406234' 254 00 0 00 406245' jrst ignore 406235' 554 01 0 00 000000 hlrz a,t ;get flags in RH 406236' 405 01 0 00 040140 andi a,(ndv!fov!fxu) ;clear all but these 406237' 242 01 0 00 777773 lsh a,-5 ;right-justify ndv 406240' 622 01 0 00 001000 trze a,(1b8) ;fov set? 406241' 435 01 0 00 000004 iori a,1b33 ;move it to right end 406242' 560 01 0 01 406251' hrro a,aprtab(a) ;get right error message 406243' 104 00 0 00 000313 esout 406244' 260 17 0 00 400041' pushj p,runer. ;put out pc and maybe go to ddt ; jrst ignore ;if he continues, ignore the error 406245' 262 17 0 00 000001 ignore: pop p,a ;[3] restore state and exit 406246' 262 17 0 00 000000 pop p,t ;[3] 406247' 105 17 0 00 777775 adjstk p,-3 ;[3] 406250' 104 00 0 00 000136 debrk 406251' 000000 407060' aprtab: [asciz /Integer overflow/] 406252' 000000 407064' [asciz /Integer divide check/] 406253' 000000 406565' [0] 406254' 000000 406565' [0] 406255' 000000 407071' [asciz /Floating overflow/] PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 30-1 PASIO MAC 7-Mar-81 20:52 error trapping 406256' 000000 407075' [asciz /Floating divide check/] 406257' 000000 407102' [asciz /Floating underflow/] 406260' 000000 406565' [0] 406261' 200 17 0 00 407106' pdltrp: move p,[xwd 20,20] ;[4] fake pdl - real one is garbage 406262' 561 01 0 00 407107' hrroi a,[asciz /No space left for stack or local variables/] ;[4] 406263' 104 00 0 00 000313 esout ;[4] 406264' 200 00 0 00 000556' move t,oldpc. ;[4] 406265' 260 17 0 00 400041' pushj p,runer. ;[4] pasddt has its own stack hrroi a,[asciz /Can't continue without stack 406266' 561 01 0 00 407120' /] 406267' 104 00 0 00 000076 psout 406270' 254 00 0 00 405215' jrst endl PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 31 PASIO MAC 7-Mar-81 20:52 critical sections subttl critical sections intern lockc.,level.,leav. entry enterc,leavec 000633' reloc 000633' izer1: 000633' level.: block 1 ;current interrupt level 000634' lockc.: block 1 ;0 or pointer to int. deferral block if in crit. section 000635' dfins0: block 1 ;interrupt deferral blocks: 000636' dfins1: block 1 000637' dfins2: block 1 000640' dfins3: block 1 000640' izer99==.-1 406271' reloc 406271' 000000 000635' dftab: dfins0 406272' 000000 000636' dfins1 406273' 000000 000637' dfins2 406274' 000000 000640' dfins3 406275' 200 01 0 00 000633' enterc: move a,level. ;set up int. deferral block 406276' 200 01 0 01 406271' move a,dftab(a) 406277' 202 01 0 00 000634' movem a,lockc. ;now in critical section 406300' 263 17 0 00 000000 popj p, 406301' 201 01 0 00 000000 leavec: movei a,0 406302' 250 01 0 00 000634' exch a,lockc. ;out of critical section 406303' 332 00 0 00 000001 skipe a ;user is doing leave without enter 406304' 336 00 0 01 000000 skipn (a) ;any deferred interrupt? 406305' 263 17 0 00 000000 popj p, ;no - normal exit 406306' 261 17 0 00 000002 push p,b 406307' 200 02 0 01 000000 move b,(a) ;deferred interrupts 406310' 402 00 0 01 000000 setzm (a) ;zero for next use 406311' 201 01 0 00 400000 movei a,400000 ;this job 406312' 104 00 0 00 000132 iic 406313' 262 17 0 00 000002 leav.: pop p,b 406314' 263 17 0 00 000000 popj p, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 32 PASIO MAC 7-Mar-81 20:52 page allocation/deallcation subttl page allocation/deallcation entry getpag,relpag ;[20] ;getpg. ; a - count of number of pages desired ;garbages a,t - result in a 406315' 261 17 0 00 000634' getpg.: push p,lockc. ;remember if user was in crit. sec. 406316' 261 17 0 00 000001 push p,a 406317' 336 00 0 00 000634' skipn lockc. ;if so, don't make new one 406320' 260 17 0 00 406275' pushj p,enterc ;critical section 406321' 262 17 0 00 000001 pop p,a 406322' 261 17 0 00 000002 push p,b 406323' 261 17 0 00 000003 push p,c 406324' 261 17 0 00 000004 push p,d 406325' 261 17 0 00 000005 push p,e 406326' 261 17 0 00 000006 push p,f ;here we set up pagmsk to be xxxx0000, with x being (a) bits 406327' 303 01 0 00 000044 caile a,44 ;be sure count is legal 406330' 254 00 0 00 406414' jrst getptm ;too many 406331' 205 02 0 00 400000 movsi b,400000 ;b _ 400000,,0 406332' 210 03 0 00 000001 movn c,a 406333' 240 02 0 03 000001 ash b,1(c) ;b _ xxx0000, as ash propogates the bit 000000 pagmsk==0 ;location of mask on stack 406334' 261 17 0 00 000002 push p,b 406335' 515 02 0 00 777761 hrlzi b,-17 ;b - aobjn pointer to word we are looking at 406336' 200 04 0 00 000001 move d,a ;d - number of pages desired ;outer loop in which we check all words i 406337' 200 00 0 02 000000' getpl1: move t,frepag(b) ;first find a word in which there are free 406340' 201 03 0 00 000000 movei c,0 ;c - accumulate previous shifts ;inner loop in which we check various starting places in word ;Note that t gets shifted if we have to retry this 406341' 243 00 0 00 406344' getpl2: jffo t,gotbit ;if free page in this word, exit search 406342' 253 02 0 00 406337' aobjn b,getpl1 ;no more bits in this word, get next 406343' 254 00 0 00 406417' jrst nofree ;ran out of words, we failed ;here is the text of the inner loop ;we have found one free page, see if we have N contiguous ones 406344' 270 03 0 00 000001 gotbit: add c,a ;c _ total shift to this bit 406345' 460 05 0 02 000000' setcm e,frepag(b) ;e,f _ complement of words being tested 406346' 460 06 0 02 000001' setcm f,frepag+1(b) 406347' 246 05 0 03 000000 lshc e,(c) ; shifted to left justify tested bits 406350' 616 05 0 17 000000 tdnn e,pagmsk(p) ;since complemented, if all are zero 406351' 254 00 0 00 406355' jrst gotpgs ;then we have our pages ;not enough bits after the one we found. We now shift the word (in t) ;to the beginning of the field we were considering plus one more bit. ;this eliminates the bit our last jffo found, and causes the next one ;to advance to the next bit. However it requires us to keep track of ;the total amount of shifting, which is done in c. 406352' 242 00 0 01 000001 lsh t,1(a) ;get to start of field, and gobble one bit 406353' 271 03 0 00 000001 addi c,1 ;indicated shifted by one more PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 32-1 PASIO MAC 7-Mar-81 20:52 page allocation/deallcation 406354' 254 00 0 00 406341' jrst getpl2 ;and see if another candidate in this word ;here when we have found the free pages ;clear the bits in frepag array and figure out page number 406355' 200 05 0 17 000000 gotpgs: move e,pagmsk(p) ;get mask for clearing 406356' 400 06 0 00 000000 setz f, 406357' 210 01 0 00 000003 movn a,c ;a _ neg no. of bits shifted 406360' 246 05 0 01 000000 lshc e,(a) ;e,f _ mask of bits found 406361' 412 05 0 02 000000' andcam e,frepag(b) ;clear bits in memory 406362' 412 06 0 02 000001' andcam f,frepag+1(b) 406363' 621 02 0 00 777777 tlz b,-1 ;now compute b _ page number 406364' 221 02 0 00 000044 imuli b,44 ;words times pages in a word 406365' 270 02 0 00 000003 add b,c ;and offset within word 406366' 242 02 0 00 000011 lsh b,11 ;d _ addr of first page in group 406367' 200 03 0 00 000004 move c,d ;c _ number of pages in group 406370' 242 03 0 00 000011 lsh c,11 ;c _ number of words in group 406371' 270 03 0 00 000002 add c,b ;c _ first address beyond 406372' 311 03 0 00 000017' caml c,lstnew ;be sure we don't overlap heap 406373' 254 00 0 00 406417' jrst nofree ;if we do, fatal error 406374' 313 03 0 00 406233* camle c,.jbff## ;if we have taken more core 406375' 202 03 0 00 406374* movem c,.jbff## ; update .jbff 406376' 200 01 0 00 000002 move a,b ;a _ address of first page in group 406377' 504 01 0 00 000004 hrl a,d ;number of pages in LH 406400' 262 17 0 17 000000 pop p,(p) ;pagmsk 406401' 262 17 0 00 000006 pop p,f ;saved ac's 406402' 262 17 0 00 000005 pop p,e 406403' 262 17 0 00 000004 pop p,d 406404' 262 17 0 00 000003 pop p,c 406405' 262 17 0 00 000002 pop p,b ;previous lock still on stack 406406' 261 17 0 00 000001 push p,a ;stack is top --> ret val , lock 406407' 336 00 0 17 777777 getpgx: skipn -1(p) ;if user was in cri. sec., don't leave 406410' 260 17 0 00 406301' pushj p,leavec ;end critical section 406411' 262 17 0 00 000001 pop p,a 406412' 262 17 0 17 000000 pop p,(p) 406413' 263 17 0 00 000000 popj p, 406414' 561 01 0 00 407127' getptm: hrroi a,[asciz /Internal error: buffer request exceeds 36 pages/] 406415' 104 00 0 00 000313 esout 406416' 254 00 0 00 405215' jrst endl 406417' 561 01 0 00 407141' nofree: hrroi a,[asciz /Request for buffer space runs into heap /] 406420' 104 00 0 00 000313 esout 406421' 254 00 0 00 405215' jrst endl ;relpg. ; a - count,,addr ;garbages a,t - arg in a 406422' 261 17 0 00 000634' relpg.: push p,lockc. ;remember whether user was in crit. sec. 406423' 261 17 0 00 000001 push p,a 406424' 261 17 0 00 000002 push p,b 406425' 261 17 0 00 000003 push p,c 406426' 336 00 0 00 000634' skipn lockc. ;if so, don't make new one 406427' 260 17 0 00 406275' pushj p,enterc ;critical section 406430' 205 00 0 00 400000 movsi t,400000 ;t,a _ 400000... 406431' 400 01 0 00 000000 setz a, PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 32-2 PASIO MAC 7-Mar-81 20:52 page allocation/deallcation 406432' 554 02 0 17 777776 hlrz b,-2(p) ;number of pages 406433' 303 02 0 00 000044 caile b,44 ;be sure its legal 406434' 254 00 0 00 406414' jrst getptm 406435' 210 02 0 00 000002 movn b,b ;b _ - number of pages 406436' 240 00 0 02 000001 ash t,1(b) ;t,a _ xxx000 with one x for each page 406437' 550 02 0 17 777776 hrrz b,-2(p) ;addr to return 406440' 242 02 0 00 777767 lsh b,-11 ;make into page number 406441' 231 02 0 00 000044 idivi b,44 ;b _ word offset, c _ bit within word 406442' 210 03 0 00 000003 movn c,c ;c _ - number of bits 406443' 246 00 0 03 000000 lshc t,(c) ;t,a _ mask of bits to set in word 406444' 436 00 0 02 000000' iorm t,frepag(b) ;clear at offset b and b+1 406445' 436 01 0 02 000001' iorm a,frepag+1(b) 406446' 262 17 0 00 000003 pop p,c 406447' 262 17 0 00 000002 pop p,b 406450' 262 17 0 00 000001 pop p,a 406451' 262 17 0 00 000000 pop p,t 406452' 336 00 0 00 000000 skipn t ;if user was in cri. sec., don't leave 406453' 254 00 0 00 406301' jrst leavec ;end critical section 406454' 263 17 0 00 000000 popj p, ;[20] Replaced old routines that did only one page. ;Routines for normal user use ;procedure getpages(howmany:integer;var pagenum:integer; var:page:^realpage); ;b - number of pages to get ;c - place to put page no.: ;d - place to put addr. 406455' 200 01 0 00 000002 getpag: move a,b ;number of pages 406456' 260 17 0 00 406315' pushj p,getpg. ;actually get page - addr in a 406457' 552 01 0 04 000000 hrrzm a,(d) ;return addr 406460' 621 01 0 00 777777 tlz a,777777 ;clear out LH (count) 406461' 242 01 0 00 777767 lsh a,-9 ;return page no. 406462' 202 01 0 03 000000 movem a,(c) 406463' 263 17 0 00 000000 popj p, ;procedure relpages(howmany:integer;pagenum:integer); ;b - number of pages to return ;c - page to return 406464' 303 02 0 00 000000 relpag: caile b,0 ;check args - count GT 0 406465' 307 03 0 00 000000 caig c,0 ;page number GT 0 406466' 254 00 0 00 406477' jrst illpag 406467' 200 04 0 00 000003 move d,c 406470' 270 04 0 00 000002 add d,b ;page + count LE 1000 406471' 303 02 0 00 001000 caile b,1000 406472' 254 00 0 00 406477' jrst illpag 406473' 242 03 0 00 000011 lsh c,9 ;make addr 406474' 200 01 0 00 000003 move a,c ;where rlpag wants it 406475' 504 01 0 00 000002 hrl a,b ;number to return 406476' 254 00 0 00 406422' jrst relpg. illpag: hrroi a,[asciz /Relpages: page numbers must be 1 to 777B 406477' 561 01 0 00 407152' /] 406500' 104 00 0 00 000313 esout 406501' 254 00 0 00 405215' jrst endl PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page 32-3 PASIO MAC 7-Mar-81 20:52 page allocation/deallcation if2,< purge sin> ;so we don't interfere with Forlib's sin prgend CMCFN UNASSIGNED, DEFINED AS IF EXTERNAL GETFE1 UNASSIGNED, DEFINED AS IF EXTERNAL GETFNX UNASSIGNED, DEFINED AS IF EXTERNAL ?3 ERRORS DETECTED HI-SEG. BREAK IS 407163 PROGRAM BREAK IS 000641 CPU TIME USED 00:15.999 69P CORE USED PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page S-1 PASIO MAC 7-Mar-81 20:52 SYMBOL TABLE A 000001 CMDBUF 000140' DSKWRT 403454' FILGLN 000020 spd AIC 104000 000131 int CMJFN 000234' DV%TYP 000777 000000 sin FILJFN 000004 spd ALCBFN 403556' CO%NRJ 400000 000000 sin DVCHR 104000 000117 int FILLBY 000012 spd ALCBUF 403546' COMND 104000 000544 int E 000005 FILLCT 000027 spd ANALYS 405224' ent CORERR 400000' ent EIOER 405063' FILLNR 000031 spd APPBIN 403515' CPOPJ 400177' EIR 104000 000126 int FILLTS 000014 spd APPEND 400236' ent CPOPJ1 403326' END 405203' ent FILPAG 000033 spd APRTAB 406251' CPOPJH 403525' ENDCL 405204' FILPBP 000012 spd ATBUF 000176' CURPBX 404400' ENDCN 405213' FILPBS 000013 spd AVAIL 406215' ext CURPOS 401540' ent ENDL 405215' ent FILPGB 000024 spd B 000002 CZ%ABT 004000 000000 sin ENDMEM 406220' ext FILPLN 000021 spd BADADV 403264' D 000004 ENTERC 406275' ent FILPTR 000000 spd BADPAG 403330' DDTGO 000021' ERCAL 320740 000000 int FILPUT 000017 spd BEG 403035' spd DEBRK 104000 000136 int ERCHOK 401355' FILR11 000016 spd BEGMEM 406217' ext DECDDT 400074' ERJMP 320700 000000 int FILR99 000023 spd BIN 104000 000050 int DELF 104000 000026 int ERP 405107' FILS11 000011 spd BLKLCK 000252' DELF. 400306' ent ERP. 405105' int FILS12 000012 spd BLKLEN 000140 spd DESX5 600154 int ERP.. 405107' int FILS13 000013 spd BLKTAB 000412' DEVFND 400605' ERPDON 405130' FILS15 000024 spd BLKTBE 400145' DEVPRM 400555' ERRACS 000022' FILS16 000025 spd BOUT 104000 000051 int DEVTAB 400624' ERRCHK 401332' FILS17 000026 spd BREAK 401650' ent DF%EXP 200000 000000 sin ERREST 400113' FILS20 000027 spd BREAKI 401652' ent DF%NRJ 400000 000000 sin ERROPT 401241' FILS21 000030 spd BUFSIZ 000036 spd DFINS0 000635' ERSTAT 405221' ent FILST1 000033 spd BXINI 404417' DFINS1 000636' ERSTR 104000 000011 int FILST2 000034 spd BXOPN 404416' DFINS2 000637' ESOUT 104000 000313 int FILST3 000035 spd BYTREC 400663' DFINS3 000640' F 000006 FILST4 000036 spd BYTTXT 400642' DFTAB 406271' F%BRK 000007 spd FILST5 000037 spd C 000003 DIC 104000 000133 int F%CURP 000004 spd FILSVF 000037 spd CFMBLK 405336' DISPC. 405157' ent F%GETX 000000 spd FILSVG 000030 spd CHFDB 104000 000064 int DISPFL 405165' F%INIT 000005 spd FILTER 000024 spd CHNTB. 000561' int DISPFN 405176' F%LTST 000010 spd FILTST 000040 spd CHROFR 404652' DOCAL 405032' F%OPEN 000006 spd FILTTB 000033 spd CHRONR 404646' DOCLOS 401563' F%PUTP 000002 spd FL%BUF 060600 000000 spd CHROP1 405721' DOJMP 405027' F%PUTX 000001 spd FL%EOL 000020 spd CHROPN 405716' DOOPE 401315' F%SETP 000003 spd FL%FME 000004 spd CHROPX 404557' DOPENF 403517' FILADV 000011 spd FL%IOE 000002 spd CHROX1 404562' DSKADV 403252' FILBAD 000007 spd FL%LC 000001 spd CHROXX 404660' DSKAPP 403503' FILBCT 000034 spd FL%MOD 140600 000000 spd CHRREC 401114' DSKBIN 403475' FILBFP 000025 spd FL%OPE 000010 spd CHRTXT 401073' DSKBN1 403470' FILBFS 000026 spd FL%TMP 000040 spd CLOCHK 401560' DSKBRI 403607' FILBGP 000036 spd FM%BYT 000001 spd CLOF2 401644' DSKBRK 403566' FILBLK 405332' FM%CHR 000006 spd CLOFB 401624' DSKCL1 403637' FILBPT 000035 spd FM%LST 000007 spd CLOFIL 401557' ent DSKCLO 403616' FILBUF 000015 spd FM%MAP 000002 spd CLONK 401610' DSKCPO 403743' FILCBY 000013 spd FM%MTA 000000 spd CLORL 401621' DSKEOF 402134' FILCHT 000010 spd FM%NUL 000004 spd CLOSF 104000 000022 int DSKINI 403527' FILCLO 000022 spd FM%REC 000007 spd CLRDON 406105' DSKLTS 403561' FILCMP 000043 spd FM%TTY 000003 spd CLREOF 405231' ent DSKMOV 403722' FILCNT 000032 spd FM%WRD 000005 spd CLRLOP 406073' DSKOP1 403447' FILEOF 000001 spd FNPROM 000124' CLROK 405244' DSKOPN 403417' FILEOL 000002 spd FOV 040000 000000 spd CM%NOP 200000 000000 sin DSKRCL 403604' FILERR 000003 spd FREPAG 000000' CMCFN 405274' udf DSKSPF 403741' FILFLG 000006 spd FXU 000100 000000 spd CMDBLK 000127' DSKSPO 403674' FILGET 000016 spd G 000007 PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page S-2 PASIO MAC 7-Mar-81 20:52 SYMBOL TABLE G1%RND 400000 000000 sin GJ%FNS 000002 000000 sin IZER1 000633' NOFREE 406417' GET. 401530' ent GJ%FOU 400000 000000 sin IZER99 000640' spd NONEW 400035' GETB 406014' GJ%IFG 000100 000000 sin JFNS 104000 000030 int NONEXT 401703' GETBLN 405544' GJ%JFN 000600 000000 sin JRSTF 254100 000000 int NONXT1 401715' GETBLP 406046' GJ%OFG 000040 000000 sin JS%AT1 000200 sin NOPUT 402034' GETBX 404322' GJ%OLD 100000 000000 sin KLCPU 000001 spd NORCHT 402171' ent GETBXR 404421' GJ%REG 000665 000000 spd LCCHT 402413' NORCHX 402613' ent GETCB1 405530' GJ%SHT 000001 000000 sin LCCHX 403035' NOTOP 405252' GETCD1 402145' GJ%XTN 000004 000000 sin LEAV. 406313' int NOTRY 401743' GETCH 401530' sen GNJFN 104000 000017 int LEAVEC 406301' ent NOUT 104000 000224 int GETCHB 405526' GNJFX1 601054 LEVEL. 000633' int NULREC 401010' GETCHD 402131' GOTBIT 406344' LEVTAB 000553' NULSPO 401550' GETCHR 403756' ent GOTOC. 405133' ent LOCKC. 000634' int NULSPX 401552' GETCHT 404126' GOTOCN 405151' LOGCLO 405740' NULTXT 400767' GETCHX 403746' GOTOL 405140' LOGCLX 404666' NUMBUF 400473' GETCLN 403235' GOTPAG 403320' LOGINI 406005' O 000016 GETCX 404466' GOTPGS 406355' LOGINX 404674' OF%APP 020000 sin GETCX1 403751' GS%EOF 001000 000000 sin LOGOPN 405651' OF%BSZ 770000 000000 sin GETCXL 404477' GS%ERR 000400 000000 sin LSTBLK 000552' OF%EX 040000 sin GETCXN 404470' GS%RDF 200000 000000 sin LSTNEW 000017' ent OF%RD 200000 sin GETD 403333' GTFDB 104000 000063 int LSTREC 404453' ent OF%REG 360000 spd GETDLP 403373' GTJFN 104000 000020 int MAKSPE 401424' OF%WR 100000 sin GETEOL 402163' GTSTS 104000 000024 int MAKSPL 401403' OLDCOM 000001 spd GETER 104000 000012 int H 000010 MAKSPR 401417' OLDPC. 000556' int GETFDF 405402' HALTF 104000 000170 int MAKSPX 401451' OP%TTY 400000 000000 spd GETFE1 405412' udf HAVSPC 401431' MAPBFS 000004 spd OP%WLD 200000 000000 spd GETFER 405342' HLTERR 400105' MAPER1 402063' OPENF 104000 000021 int GETFH1 405375' IGNORE 406245' MAPER2 402120' OPENFI 401303' GETFH2 405377' IIC 104000 000132 int MAPER3 402121' OPER 401314' GETFHL 405355' ILFIL. 400117' ent MAPERR 402040' OPNTTY 400547' GETFN. 405256' ent ILLFN 405002' ent MAPQUO 402076' OPTBYT 400502' GETFN1 405274' ILLPAG 406477' MAPREC 400725' OPTDCL 400515' GETFNA 000235' INIBLK 405326' MAPTXT 400704' OPTDCX 400532' GETFNX 405413' udf INIT.B 405436' ent MTAANS 404756' OPTDEC 400506' GETFPG 403267' INITB. 405414' ent MTABX 404765' OPTEND 400437' GETFPN 403304' INITBC 405426' MTACHR 404770' OPTERD 400536' GETJFN 401357' INITBF 405440' MTALOG 404737' OPTERR 400541' GETLN 401532' ent INPUT 405517' ext MTAOPN 404703' OPTION 400412' GETLNX 404301' ent INXERR 400125' ent MTARD 404742' OPTLOP 400422' GETLX 404537' IOEBCP 405576' MTAREC 401177' OPTMAX 000125 spd GETLX1 404300' IOECBP 404113' MTATXT 401177' OPTMIN 000102 GETNEW 400007' ent IOECP 405577' MTAWRD 404775' OPTMOD 400467' GETPAG 406455' ent IOER 405064' MTOPR 104000 000077 int OPTTAB 400443' GETPG. 406315' ent IOERB 403776' MTOX1 601210 int OUTPUT 405407' ext GETPGX 406407' IOERBC 403775' N 000015 OVRFLW 406222' GETPL1 406337' IOERBX 404350' NDV 000040 000000 spd P 000017 GETPL2 406341' IOERP 405065' NEW 400023' ext PA%EX 020000 000000 sin GETPTM 406414' IOERP2 405073' NEWBND 000020' ent PA%IND 004000 000000 sin GETTTY 404000' IOERP5 404176' NEWCL. 400022' ent PA%PEX 010000 000000 sin GETX. 401542' ent IOERPX 405061' NEWERR 400131' PA%WT 040000 000000 sin GETXB 406034' IOX11 601440 int NEWNIL 400017' PA2040 000000 spd GETXBX 404334' IOX2 600216 int NEWXIT 400015' PAGMSK 000000 spd GETXD 403353' IOX20 602234 int NEXTFI 401674' ent PASIF. 406064' ent GJ%CFM 020000 000000 sin IOX4 600220 int NIN 104000 000225 int PASIN. 406062' ent GJ%FLG 000020 000000 sin ISQUOT 405040' NODDT 400065' PASIN1 406134' PASIO - I/O routines for TOPS-20 Pascal MACRO %53A(1152) 20:53 7-Mar-81 Page S-3 PASIO MAC 7-Mar-81 20:52 SYMBOL TABLE PASIN2 406145' RESDEV 401554' ent TRYDDT 401766' .JBSA 406105' ext PASIN3 406162' RESET 104000 000147 int TRYNOD 402010' .LTUNL 000001 sin PASIN4 406167' RESETF 400154' ent TRYOK 402016' .MORLI 000050 sin PBOUT 104000 000074 int RETBA 405024' TTOCR1 404046' .MORRS 000015 sin PDLTRP 406261' RETZER 401546' TTOCR2 404032' .PRIIN 000100 sin PM%CNT 400000 000000 sin REWRIT 400221' ent TTOCUR 404027' .PRIOU 000101 sin PM%PLD 010000 000000 sin RFPOS 104000 000111 int TTSHL3 404100' PM%RD 100000 000000 sin RFPTR 104000 000043 int TTSHL4 404075' PM%WR 040000 000000 sin RLJFN 104000 000023 int TTY 400406' ext PMAP 104000 000056 int RNAMF 104000 000035 int TTYADV 404005' PMAPX6 601107 int RPACS 104000 000057 int TTYBSZ 000372 spd POSDON 403677' RUNER. 400041' ent TTYBUF 000042' POSNOC 403710' SAFBEG 406227' ext TTYFXL 404110' PROTOB 405442' SAFEND 406230' ext TTYINI 404124' PSOUT 104000 000076 int SAMBSZ 403671' TTYNT 401220' PTCXER 404463' SAVERR 405623' TTYOUT 400407' ext PTRER. 400135' ent SETDSP 400612' TTYPR. 405506' ent PUT 401531' ent SETPB 406002' TTYPRG 405517' PUTB 406024' SETPBX 404406' TTYREC 400663' spd PUTBLP 406054' SETPOS 401536' ent TTYSHL 404055' PUTBX 404353' SETPR1 400340' TTYSPC 401502' PUTBXR 404436' SETPRM 400325' TTYSPE 401515' PUTBY 404354' SETPT 404172' TTYSPL 401505' PUTCH 401531' sen SFPTR 104000 000027 int TTYTXT 400746' PUTCHB 405521' SHOWLN 401720' TXTIER 404200' PUTCHD 402023' SIMEOF 402135' UNIMP 405002' spd PUTCHX 403765' SIMERR 405645' UNOP 401262' PUTCX 404456' SIMERX 405644' UNOP. 401262' PUTD 403343' SINR 104000 000531 int UPDATE 400200' ent PUTDLP 403405' SIR 104000 000125 int WRDLTS 403561' PUTLN 401533' ent SIZEFI 403643' WRDOPN 405727' PUTLNX 404306' ent SMOPER 401320' WRDREC 401052' PUTLX 404506' SOUT 104000 000053 int WRDTXT 401031' PUTLXX 404530' SOUTR 104000 000532 int WRTBUF 405555' PUTPG 401534' ent SPEC 000001 spd .CMBFP 000003 sin PUTPGX 404314' ent SPECER 401455' .CMCFM 000010 sin PUTTTY 404117' SRERR 400141' ent .CMCNT 000005 sin PUTX 401544' ent SRISW 000000 .CMFIL 000006 sin PUTXBX 404367' STSTS 104000 000025 int .CMINC 000006 sin PUTXD 403365' SUMEX 000000 spd .CMINI 000014 sin QUIT 405203' ent T 000000 .CMPTR 000004 sin QUOCHK 405006' TDOCR1 404227' .DVCDR 000010 sin RD%JFN 004000 000000 sin TDOCR2 404214' .DVDSK 000000 sin RD%TOP 200000 000000 sin TDOCUR 404202' .DVLPT 000007 sin RDTTY 104000 000523 int TDVADV 404143' .DVMTA 000002 sin REABUF 405602' TDVFXL 404275' .DVNUL 000015 sin RECREC 401156' TDVOPN 404135' .DVTTY 000012 sin RECTB 404663' TDVSH1 404257' .FBBYV 000011 sin RECTXT 401135' TDVSH3 404263' .FBSIZ 000012 sin RELF. 401556' ent TDVSH4 404260' .FHSLF 400000 sin RELPAG 406464' ent TDVSHL 404236' .GJGEN 000000 sin RELPG. 406422' TENEX 000000 spd .JBDDT 401755' ext RENAME 400253' ent TEXTI 104000 000524 int .JBFF 406375' ext RENER 400300' TRYAG1 401755' .JBOPC 400074' ext RENER1 400303' TRYAGN 401751' .JBREN 400112' ext NEW ; FAKE ENTRY IN CASE DISPOSE NOT INCLUDED MACRO %53A(1152) 20:53 7-Mar-81 Page 32-4 PASIO MAC 7-Mar-81 20:52 TITLE NEW ; FAKE ENTRY IN CASE DISPOSE NOT INCLUDED SEARCH PASUNV ENTRY NEW 000000* NEW=GETNEW## 400000' TWOSEG 000000' RELOC 0 000000' AVAIL:: BLOCK 2 000002' BEGMEM::BLOCK 1 000003' ENDMEM::BLOCK 1 400000' RELOC 400000 PRGEND NO ERRORS DETECTED HI-SEG. BREAK IS 400000 PROGRAM BREAK IS 000004 CPU TIME USED 00:00.019 69P CORE USED NEW ; FAKE ENTRY IN CASE DISPOSE NOT INCLUDED MACRO %53A(1152) 20:53 7-Mar-81 Page S-4 PASIO MAC 7-Mar-81 20:52 SYMBOL TABLE AVAIL 000000' int BEGMEM 000002' int ENDMEM 000003' int GETNEW 000000 ext NEW 000000* ent DANGER - routine for dummy label when pasnum not loaded MACRO %53A(1152) 20:53 7-Mar-81 Page 33 PASIO MAC 7-Mar-81 20:52 title DANGER - routine for dummy label when pasnum not loaded entry safbeg,safend 000000' safbeg: block 0 000000' safend: block 0 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 CPU TIME USED 00:00.012 69P CORE USED DANGER - routine for dummy label when pasnum not loaded MACRO %53A(1152) 20:53 7-Mar-81 Page S-5 PASIO MAC 7-Mar-81 20:52 SYMBOL TABLE SAFBEG 000000' ent SAFEND 000000' ent