Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0003/pasio.lst
There are no other files named pasio.lst in the archive.
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,<printx Tops-20 version>
ifn tenex,<
ifn sumex,<printx Sumex version>
ife sumex,<
ifn pa2040,<printx Tenex PA2040 version>
ife pa2040,<printx Tenex non-PA2040 version>
>;ife sumex
>;ifn tenex
ifn srisw,<printx SRI line number kludge included> ;[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,<mapbfs==1> ;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,<push p,a> ;[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,<movei a,fm%mta>
ifn tenex,<movei a,fm%wrd>
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,<printx Using KL instruction (ADJBP) at QUOBPT+>
;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,<ibp filbpt(b)>
> ;[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,<exp .-beg> ;real letter
define lc,<exp .-beg-40> ;upper case equiv. of lower case letter
define linech(x),<xwd x,.-beg> ;end of line char
402171' norcht:
402171' beg==norcht
repeat 12,<letter> ;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,<letter> ;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,<letter> ;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,<linech 1> ;37
402230' 000000 000037 ife tenex,<letter> ;37
repeat 162,<letter> ;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,<letter>
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,<letter>
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,<letter> ;34 - 36
402447' 000000 000034
402450' 000000 000035
402451' 000000 000036
ifn tenex,<linech 1> ;37
402452' 000000 000037 ife tenex,<letter> ;37
repeat 101,<letter> ;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,<lc> ;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,<letter> ;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),<xwd x," "> ;end of line char
;otherwise the tables are the same
402613' norchx:
402613' beg==norchx
repeat 12,<letter> ;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,<letter> ;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,<letter> ;34 - 36
402647' 000000 000034
402650' 000000 000035
402651' 000000 000036
ifn tenex,<linech 1> ;37
402652' 000000 000037 ife tenex,<letter> ;37
repeat 162,<letter> ;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,<letter>
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,<letter>
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,<letter> ;34 - 36
403071' 000000 000034
403072' 000000 000035
403073' 000000 000036
ifn tenex,<linech 1> ;37
403074' 000000 000037 ife tenex,<letter> ;37
repeat 101,<letter> ;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,<lc> ;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,<letter> ;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,<hrli a,.fbbyv> ;the offset - byte size
403621' 505 01 0 00 400011 ife tenex,<hrli a,400000!.fbbyv> ;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, <printx Be sure to change TRMTAB as appropriate for your site>
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 ;<beep!>
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,<ibp d>
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