!!Transcription by jsm February, September, October 2002
!!Page 7
	ttl	 	!Dartmouth Time-Sharing System 235 Executive!1
	stl 		!Initial Loader
	loc 34000  	!Date of latest reassembly goes here
#date: 	bss 0
	oct 1032	!Update August 26, 1965 [RPL]



,     Dartmouth College Time-Sharing System
,                              235 Executive

,     Richard P. Lacey [67]  April 1965 -
,     John S. McGeachie [65]  April 1964 - April 65

,     Phase IV
,       For 44 teletype disk allocation of July 13,
,       1965.


,     16K Loader - will load 16K GAP cards into
,     upper or lower memory. Accepts single or
,     multiple origin cards and octal corrections.
,     Octal corrections may be single or multiple
,     origin. Scan terminated by single character
,     field.
,     Author Charles G. Moore [65]


	loc 3000
#r: 	bss 42		!read-in area
#rw: 	bss 41 		!analyze area
octacc:	bss 1 		!working storage for octal corrections
octadd: 	bss 1
#wdct: 	oct 2017777	!mask to leave address and sign bit
#R2: 	dec #rw  	!card move constants
	dec -40
#mc: 	dec 2		!memory clear constants
	dec -1533
#mc1: 	dec #last+1
	dec -12286
#addr: 	oct 1760000	!address correction mask
#8k: 	dec 8192
octc: 	oct 3776000 	!octal correction mask
#load1: 	ldz 		!check switch 19 for memory clear
	sta #last		!clear to contents of switches
	sta 1
	ldx 8k,2		!get upper bit
	lda #date,2	!and save date
	sta #x3sv
	dld #mc
	mov 1
	rcs		!Check if clear later part
	sta #sflag	!Set systems flag
	bod
!!Page 8
	bru #load	!No
	dld #mc1
	mov #last
	ldx #8k,1	!Restore at earliest
	lda #x3sv
	sta #date,1	!opportunity
#load:	rcb #r		!Read first card - fill buffer
	hcr		!but is loaded normally
	ldz		!Make sure we start in lower bank
	sta #x3sv
#r1: 	dld #r2		!Normal entrance for card read
	bcn
	bru *-1		!Wait for reader ready
	mov #r		!and then move from read buffer
	sta #rw+40	!Set zero to end of card image
	ldx #zf,1	!Set up for scan
	ldx #x3sv,3	!Restore X3
	lda #rw,1	!RW is working area - get control word
	bze
	bru #oct
	ext #wdct
	bze
	bru #t
	rcb #r
	hcr
	sra 13
#ze: 	sta 0
	lda #rw,1
	ext #addr	!Leave address and sign bit
	bmi		!If upper 8k add index bit
#dart2:	bru #dart1	!First Dartmouth-style card found
	sto 3		!Otherwise, GAL convention
#ret: 	inx 1,1		!is return for each word in string
	lda #rw,1
	sta 0,3		!Put it away
	add #rw-1,1	!totaling for checksum
	bov
	ado
	sta #rw,1	!Save present checksum
	inx -1,0		!Bump down word counter
	inx 1,3		!and bump up address counter - put away
	bxh 1,0		!and check for end of string
	bru #ret		!If not, put away another word
	sub #rw+1,1
	bze		!Check checkword
	bru *+3
	lda #rrr		!If not, set up for error halt
	bru *		!Recover is backspace A-I start
	inx 2,1
	lda #rw,1
	ext #wdct
!!Page 9
	bnz
	bru #ze-1
#rrr: 	bru #r1		!Go get another card
#t:	lda #rw,1	!Get transfer address
	bmi
#dart3:	ldx #8k,3	!If first Dartmouth-style, do not panic
	sto 3		!Else GAL
	lda #sflag	!Save systems flag
	sta sload
	bru 0,3		!exit
	add #8k
#dart1:	lda *-1		!Set instructions for Dartmouth style
	sta #dart2
	sta #dart3	!Reset transfer
	lda octe+1
	sta #dart2+1
	sta #dart3+1
	bru #ze+1	!Get back

,     Free-form octal corrections -

#oct:	 rcb #r
	hcr
	ldx #ze,2
	stx #x3sv,3	!Save index register 3
	bru octe
octb: 	sra 10
	ext octc		!Get left half of word, and dump rest
	nor 16
	sla 1
	lda octacc
	bov		!If overflow, there is a word
	bru octd
	bxl 2,3
	bru octe
	bxl 3,3
	bru #r1		!Single character field - get out
	bxh 7,3
	bru octf
	sta octadd	!Or address
octe:	ldz
	sta 3
	lqa
	bru octa-1
octd:	sld 3
	ext 0
	bno
	chs
	sta octacc
octa:	inx 1,3
	bxh 40,1
!!Page 10
	bru #r1		!Card finished
	lda octc
	lqa
	lda #rw,1
	bxl 1,2
	spb octb,2
	inx 1,1
	ldx #ze,2
	bru octb+1
octf:	ldx octadd,3
	sta 0,3
	inx 1,3
	stx octadd,3
	bru octf
#x3sv:	bss 1		!X 3 temporary save
#sflag:	bss 1		!Systems temporary flag
#last:	equ *
	tcd #load1

	stl		!Disk loader for systems and executive
	ejt
!!Page 11

,     Load checks switch 7 - if down, then no
,     billing is desired, so KBILL and IREC are
,     inhibited.
,     - if up, billing is desired.


,     The SRES sequence performs a series of
,     checks to insure that
,     1] the SPR switch is set to the all position
,     2] the disk is clear
,         and the 6k mod is working
,     3] the console switches are reset
,     4] the AAU is ready
,     If any of the above conditions fail to
,     be true, the console typewriter will type
,     a message to the operator and continue to
,     do so until the condition has been corrected.

,     5] SRES also checks the batch flag. If on,
,     it crumps the switch check and sets up an
,     entry into the batch overlay in the task
,     list.
,     6] It reads in the summary record from the
,     disk and resets it to zero if the bootstrap was
,     typed on TTY 1.

	loc 1000
load:	bss 0
	ton
	sxg 0		!Set zero in case switch bad
	ldx 8k,3
	lmo		!Set disk flag 2 on
	sta dkflg2
	ldz		!and set address for relinquish
	sta relad,3
	rcs		!Check billing switch
	ext $bmsk	!billing mask - oct 3767777
	sta $bf		!and set in flag
	bnz1
	bru *+4		!Billing not set
	spb $ertyp,2	!Billing flag on
	dec bon
	bru sres
	spb $ertyp,2	!Billing flag off
	dec boff
	lda $nob		!Inhibit KBILL and IREC
	sta kbill,3
	sta irec,3

sres:	sxg 0
!!Page 12
	set pbk		!and prevent interrupts
	lda sign
	sta pmbx0
	ton
	ldz		!Now find out what group we are in
	sta xr01
	sta z1
	spb *+1,1
	lda xr01
	bnz
	bru saok		!Ok, neither API not Trap
	lda z1		!API...
	bnz
	set pst		!yes, exit
	set pbk
	set trpmode
	set ntpmode
	ldx zero,2	!and exit
	bru *+1,2
saok:	sxg 5		!continue
	ldx 8k,3		!Set upper 8k bit on
	ldx zero,1	!Test SPB switch
	spb *+1,1
	bxh 1,1		!If 1 is higher than 1, then SPB switch is
	bru *+6		!set to all, else it is at 0
	sxg 0		!set 0
	ldx 8k,3		!Upper 8k bit on
	spb $ertyp,2
	dec rspb		!Reset SPB switch to all
	bru sres		!Go back and test again
	bar bar,7		!See how AAU is
	bru *+4
	spb $ertyp,2
	dec raau		!Loafing
	bru sres		!and check again
	spb $dkstst,2	!Get disk
	lda loadf		!Check for card load
	bmi		!If load flag on,
	bru loadc	!then punt message this time

,     If batch bootstrap do not bring in the summary
	lda sbak		!See if batch
	bpl
	bru *+12
	lda sbak+1		!See if have a front
	sta io1		!minus if a front card was around
	dld .sres.		!Batch - so set up return
	dst iplst,3
	dld bsums1		!Get summary back
	mov bsums
	lac			!Compute batch running time
!!Page 13
	sub otim1t,3
	add fkbat
	sta fkbat
	bru skex		!and get out

,     procede with normal bootstrap
	sel 0
	prf ,0		!Position for efficiency record
	oct 402
	bcs brn,0
	bru *-1
	sel 0
	rrd 1,0
!! original code shows 'fclock' in operand field
	dec fclock		!!Verify value is 0000600
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0
	bru *-11
	lda sign		!Reset special mailbox to normal status
	sta pmbx0
	lda fclock		!Check starting time
	bnz			!If not zero, then regular bootstrap
	bru soak2		!so skip initialization
	dld fclear		!If zero, clear summary area
	mov fclock
	sta acrun
	sta acswap
	sta acdisk		!Initialize accumulated time counts
	sta acbat
	lac			!Get starting time
	sta fclock
	sta acstrt
	spb $time,2
,     Pick up starting times for short-run summary
	dst fstim
	dst astim2		!Long run summary
	sel 0			!Rewrite on disk
	prf ,0
	oct 402
	bcs brn,0
	bru *-1
	sel 0
	wrf 1,0
	dec fclock
	bcs brn,0
	bru *-1
	bcs ber,0
	bru *-11
soak2:ldx zero,1		!Reset flag
	lda f4,1		!and transmit summary so far to accumulator
	sta fkedit,1
!!Page 14
	inx 1,1		!Step count
	bxl fkbat-f3,1	!and test if done
	bru *-4		!No
	lda ohzyf,3
	sta bzyf

,     Further checks to make sure system is working
	ldz			!Check for switch 1 down
	bcs
	bze
	bru *+3
	spb $ertyp,2
	dec res		!Reset switches
	lda exec2+1,3	!Check 6K mod on disk
	sub 1025		!Left in from bootstrap
	bnz
	Bru *+4		!OK
	spb $ertyp,2
	dec sdsd
	bru load1		!Try again
	lda $bf		!Billing flag
	bnz
	bru stime		!Not on, crump
sboot:spb $twait,2	!Wait for tape
	bru *-1		!Try again
	sel 1			!If OK, write
	wtb boot,0		!Bootstrap message
	dec 30		!Different length
	spb $twait,2	!Check again
	bru sboot		!Try again
	bru stime		!Get around buffer
stime:spb $time,2
	sta d1		!Store it in done statement
	laq
	sta d1+1
	spb $ertyp,2
	dec d
	lda tmm		!Temporary malfunction
	sta mbx1
	lda kermes		!Error message
	sta mbx0

skex: spb $relin,2	!Get rid of the disk
	ldx zero,2
	lda pmbx0		!Wait for d-30 to answer
	bmi
	bru *+5
	inx 1,2		!See how long he takes
	ldx zero,1		!Waste time
	bxl 8190,2
	bru *-6		!2/3 of a second
!!Page 15
	kon			!Go on with load
	oct 2506014		!Priority request
	bru wait,3		!Get out


$relin: bru relin,3
$time:  bru time,3



$twait:lda dtime		!Get inteval
	bcs btr,1		!If tape ready
	bru 2,2		!return OK
	maq			!Save count
	rcs			!Check switches
	sra 19-7		!and check switch 7
	bod
	bru stime		!If down, punt
	laq			!Else keep counting
	sbo			!else count
	bpl
	bru $twait+1	!Still OK
	stx $temp,2		!Save register
	spb $ertyp,2	!and type message
	dec $tpnr		!Tape not ready
	ldx $temp,2		!Get register
	bru 1,2		!and bad return



$ertyp:ldx zero, 0	!Initialize coutner
	lda 1,2		!and get address of message
	sta temp
	ldx temp,1
	ton			!Turn on typewriter
	bnr			!and check if ready
	bru $type1
	inx 1,0		!Count
	bxl 8190,0
	bru *-4		!and keep trying
	bru 2,2		!Exit if not ready

$type1:lda 0,1		!Get word
	ext sign		!and get rid of sign
	srd 12		!Get most in Q
	inx 1,1		!and step pointer
	ldx zero,0		!Reset counter

$type:stx temp,0		!Save character pointer
	bnn			!and wait for ready
	bru *-1
!!Page 16
	inx 1,0		!Step counter
	bxl 100,0		!Stupid typewriter - IBM equipment
	bru *-4		!Make sure ready 50 times before using
	ldx temp,0		!Restore character pointer
	cab peom		!and check for end of message
	bru *+2		!no
	bru 2,2		!Exit
	san 6			!else type
	typ
	inx 1,0		!Step character counter
	bxh 3,0		!One word typed...
	bru $type1		!yes
	sld 6			!Get next character
	bru $type		!and type it


$tpnr:bss 0			!Tape controller not ready.
	oct 373772		!Tape controller not ready
	alf tap		!Make sure handler 0 has a scratch tape
	alf e c		!and is on remote.  Then clear controller
	alf ont
	alf rol
	alf ler
	alf & no
	alf t r
	alf ead
	oct 701537
	oct 754421
	alf ke& 
	alf sur
	alf e h
	alf and
	alf ler
	alf & 0& 
	alf has
	alf & a& 
	alf scr
	alf atc
	alf h t
	alf ape
	alf & an
	alf d i
	alf s o
	alf n	r
	alf emo
	alf te.
	oct 376330
	alf en
	alf cle
	alf ar& 
	alf con
!!page 17
	alf tro
	alf lle
	oct 513355

,     Messages

res:	bss 0			!Reset switches
	oct 374124
	alf set
	alf & sw
	alf itc
	alf hes
	oct 557777

rspb:	bss 0			!Set SPB switch to all
	oct 376225
	alf t s
	alf pb& 
	alf swi
	alf tch
	alf & to
	alf & al
	oct 435577

boot:	bss 0
	oct 2606060
	oct 557755		!Special pattern
	alf boo
	alf tst
	alf rap
	alf & no
	oct 333535
	alf & & & 
	alf & & & 
	alf & & & 
	alf ---
	alf & & & 

d:	bss 0			!End load   Date and time.
	oct 372545
	alf d l
	alf oad
	alf & & & 
date:	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & t
	alf ime
d1:	alf & & & 		!Time goes in these two locations
!!Page 18
	alf & & & 
	alf & ho
	alf urs
	oct 373755
	oct 2606060

bon:	bss 0			!Billing flag set to bill
	oct 372231
	alf lli
	alf ng& 
	alf fla
	alf g s
	alf et& 
	alf to& 
	alf bil
	oct 433355

boff:	bss 0			!Flag set for no bill
	oct 372643
	alf ag
	alf set
	alf & fo
	alf r n
	alf o b
	alf ill
	oct 335577

sdsd:	bss 0
	alf som
	alf e f
	alf ool
	alf & ch
	alf ang
	alf ed& 
	alf the
	alf & 6K
	alf & mo
	alf d s
	alf wit
	oct 233037
	oct 557777

raau:	bss 0			!AAU loafing
	alf aau
	alf & lo
	alf afi
	alf ng.
	oct 373755
	ejt			!Page 19
!!Page 19
,     The main body of the executive is first put
,     on the disk.  The 16K loader is then
,     re-entered to read in the executive
,     overlays, each of which is put on the disk
,     in turn.  The last overlay is followed by two
,     transfer cards, the second of which transfers
,     to the SRES routine which types out the
,     DONE message to signify loading has been
,     completed.


loadc:ldz			!Reset load flag
	sta loadf
	lda sload		!Check system flag
	bpl			!If not on,
	bru lself		!Load executive
	dld .set.		!Set up linkage
	dst iplst,3		!Set in list
	set pst		!Just in case
	oct 2506014		!SET PRQ
	bru wait,3		!and scram

set:	dld unset		!delete entry
	dst iplst,3
	inx sys,2		!and set for system
	bru perget,3

,     write bootstrap on the disk
lself:bcs brn,0		!Put loader on the disk first
	bru *-1
	sel 0
	prf			!Position
	oct 2476		!Disk 0, Position 5, Record 31
	bcs brn,0
	bru *-1
	sel 0
	wrf 1,0
	dec load1		!Loader
	bcs brn,0
	bru *-1
	bcs ber,0
	BRU *-11
	lda mask6		!Convert loader to write executive on disk
	sra 3			!Place a 37 in highorder bits
	ory load2
	ory load3
	lda zero
	sta in		!Zero out some critical locations
	sta mbx0
	lda $bldv		!Pick up branch and overwrite bootstrap
	sta ltrans
!!Page 20
	bru load1


loadov: ldz			!Clear overlay areas
	sta execov,3
	dld ovclr
	mov execov
	sxg 0			!Set zero for loader
	bru #load		!and reenter it


lovwrt: bss 0
	sxg 5
	ldx 8k,3
	ldx pernum+1,2	!Pick up overlay address pointer
	lda 2,2
	bmi			!If negative, error, so crump works
	bru *
	sta relad,3		!Set for relinquish
	sta *+5		!Put away in position location
	bcs brn,0		!Wait for disk ready
	bru *-1
	sel 0
	prf ,0		!Position
	oct 0
	bcs brn,0
	bru *-1
	sel 0
	wrd 8,0		!Write
	dec execov
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0		!Errors...
	Bru *-11		!If so, rewrite
	bru loadov		!Continue picking up overlays


$dktst:ldx zero,0		!Set counter
	ldo			!and ask for disk
	sta pmbx0
	lda dtime
	bcs brr,0		!Check if ready
	bru 1,2		!If so, exit
	sbo			!Decrement
	bpl			!and wait again
	bru *-4
	inx 1,0		!Increment
	bxl 3,0
	bru $dktst+1	!and try again
	stx $temp,2		!Save entry
	spb $ertyp,2	!and type a nasty mesage
!!Page 21
	dec dc
	ldx $ttemp,2	!Restore entry
	bru $dktst		!and wait again
.set.: ldx zero,2		!Set pointer
	bru set,2
bsums1: dec fkedit
	dec -8
ovclr: dec execov+1
	dec -511
unset: bru iplst+2
	dec 0
fclear: dec flapse	!Constant to clear out summary area
	dec f1-f2
.bres.: spb bres,1	!Reset entry to batch
	dec -1
date1: dec date		!Date move constants
	dec -5
date2: dec sdate
	dec -6		!plus coded date
dtime: oct 40000		!Disk waiting time
$bmsk: oct 3767777	!Billing flag mask
$nor: bru 1,2		!Tape inhibit
$bldv: bru loadov		!Bootstrap overwrite
pernum: bss 2		!Overlay number and address pointer
$bf: bss 1			!Billing flag
$temp:bss 1			!Storage

	stl			!Bootstrap
	ejt			!Page 22
!!Page 22


,     Disk map of 235 executive

,     Tracks 0-4 are reserved for the D-30

,           0 5 0-30  Batchsim
,     2476  0 5 31    Bootstrap
,     2500  0 5 32    Lower memory portion
,     2540  0 5 48    Upper memory portion
,     2600  0 5 64    more upper memory

,           0 6 0-31  Batchsim
,     3100  0 6 32    Card lister
,     3120  0 6 40    Reproducer
,     3140  0 6 48    System loader
,     3160  0 6 56    Catalogue files
,     3200  0 6 64    Catalogue printout
,     3220  0 6 72    Disk dump
,     3240  0 6 80    Disk load
,     3260  0 6 88    Billing overlay

,     3400  0 7 00    Batch front card record
,     3500  0 7 32    System loader
,     3520  0 7 40    GAP lister
,     3540  0 7 48    Efficiency summary of system
,     3560  0 7 56    Time-sharing background monit
,     3600  0 7 64    Background monitor part two
,     3620  0 7 72    Sysout lister
,     3640  0 7 80    Tape subroutine
,     3660  0 7 88    Batch systems catalogue

,     4100  0 8 32    T-S batch system monitor
,     4120  0 8 40    T-S batch part three
,     4140  0 8 48    T-S batch part two
,     4160  0 8 56    T-S batch part four
,     4200  0 8 64    Card to tape

,     Tracks 10 to 31 are for systems

,     24100 0 40 32   Batch dump areas
,     24500 0 41 32
,     25100 0 42 32
,     25500 0 43 32

,     30000 0 48 00   Batch scratch areas
,     30400 0 49 00
,     31000 0 50 00
,     31400 0 51 00

,     32000 0 52 00   Batch loaders
!!Page 23

,     40000 1 00 00   Batch programs
,      to
,     51400 1 19 00

	loc 6000		!225 Executive bootstrap
load1: bcs brn,0		!Wait for disk ready
	bru *-1
	sel 0			!Position
	prf ,0
	oct 2500
	bcs brn,0
	bru *-1
	sel 0			!Read in lower memory part
load2: rrf 16,0		!16 records
		%0		!from beginning of memory
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0		!Check for errors
	bru *-11
	sel 0			!Position again
	prf ,0
	oct 2540
	bcs brn,0		!Wait
	bru *-1
	sel 0			!Read in first K of program
load3: oct 1210010	!Read 24 records
	z01 exec1,1
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0		!Check for errors
	bru *-11
	lda sbak
	bmi
	bru *+13		!!Whatever possessed someone (me?) to do this?
	sel 0			!Position for OBA from last dump
	prf ,0
	oct 25660
	bcs brn,0		!Wait
	bru *-1
	sel 0
	rrf 8,0		!Put it back
	%execov
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0		!Check for errors
	bru *-11
	sel 0			!Pick up date for output message
	prf ,0
	oct 400
	bcs brn,0		!Wait
!!Page 24
	bru *-1
	sel 0			!Read in date
	rrf 1,0
	%ldate		!into date region
	bcs brn,0		!Wait
	bru *-1
	bcs ber,0		!Error check
	bru *-11		!If errors, re-read
	dld date1
	mov ldate+3
	dld date2
	mov ldate+2
ltrans: bru sres
	loc 6074		!Special flags
sbak:  dec 0		!Background-in-operation flag
	dec 0
sload: dec 0		!System load flag
loadf: dec -1		!Initialize load flag at -1
ldate: eqo 10000

	stl			!Lower-lower storage
	ejt
!!Page 25
	loc 0
	bss 1			!Index registers used by Edit
xr01: bss 1
xr02: bss 1
xr03: bss 1
xr10: bss 1
xr11: bss 1
	bss 1
	bss 1
ech2: bss 1			!Character holders for echar
ech3: bss 1
eselec: bss 1		!Binary line number for selective list
	bss 1			!Starting disk address for selective list
edy:	bss 1			!Address of CR at end of instruction
edt:	bss 1			!Address of CR at end previous instruction
edz:	bss 1			!Line number currently being adjusted
	bss 5			!Other index registers
	bss 2			!X-group 5
xr52:	bss 2
ty:	bss 20		!Typewriter input line build
t:	bss 16		!Temporary storage for peripheral routines
ta:	equ t+4		!Space for tape subroutine storage
dkflg1: bss 1		!Disk flag 1 for regular tasks
dkflg2: bss 1		!For extra tasks
iadrs: bss 2		!Disk addresses, second is memory location
in:	bss 2			!Current system identifier and rep number
mstemp: bss 2		!Temporary storage
save:	bss 2			!A and Q saved by interrupt routine


bzyf:	bss 1			!Busy flag
dcnt:	bss 1			!Disk operations counter
dival:bss 1			!Disk operations elapsed time interval
drcnt:bss 1			!Disk operations error counter
dstakf: bss 1		!Gives number of disk requests stacked up
.eff:	bss 1			!Efficiency flag
hdskd:bss 1			!Time counter for disk requests
inov:	bss 1			!Overlay in use by current system
inpnt:bss 1			!Points to disk address of current system
.ins:	bss 1			!Insert task save
int1:	bss 1			!Interrupt time for 235
isum:	bss 1			!Clock save at interrupt time
itim:	bss 1			!Real time + 1 minute
kanswr: bss 1		!Answer for Datanet-30
kret:	bss 1			!Temporary storage for Datanet-30 routines
pcnt:	bss 2			!Word and character counters used by ptype
pct:	bss 1			!P counter save
perin:bss 1			!Indicates peripheral task currently in mem.
preg:	bss 1			!P-counter save for kdump
ptemp:bss 1			!Storage for word currently being type
rawt:	bss 1			!Temporary storage
!!Page 26
stack:bss 1			!Backlog of typewriter requests
swflg:bss 1			!Switch flag for next sector and peripherals
temp:	bss 1			!Temporary storage
typf:	bss 1			!Typewriter usage flag

,     Accumulator for systems operation summary

fkedit: bss 1		!0 - Mailbox routine numbers
fkstrt: bss 1		!1
fkwtnu: bss 1		!2
fkdump: bss 1		!3
fkread: bss 1		!4
fkwrit: bss 1		!5
fktea:bss 1			!6
fkbat:bss 1			!Batch accumulator
f3:	equ fkedit-1


cmess:oct 0			!Peripheral communications
cmessb: bss 1		!Batch flag
eavail: dec eplst		!End of list
einit:dec iplst		!Start of task list
ovtsk:dec 0			!Either zero or pointing to routine loc.
ty1:	dec 0			!Word pointer for typweriter input
ty2:	dec 8192		!Character pointer for typewriter input

.dskc.: spb dskc,1	!Entries
.dskd.: spb dskd,1
.dsec.: spb dsec,1	!dskop continuation
.dskx.: spb dskx,1	!Disk request entry for dska, part 2
.krst.: bru krst,3	!Trap restore branch
.krex.: spb krex,1	!Special interrupt-trap branch
.kset.: spb kset,1	!kdump disk write entry
.ktri.: bru ktri,3	!Branch to check trapmode
.ktrs.: bru ktrs,3	!Trap save check
.ktrs]: spb tx2,0		!Trap check
.kwrt.: spb kwrt,1	!Entry for source rewriting
.syov.: spb syov,1	!Overlay read entry
.pms1.: spb pms1,1	!Typewriter entry

	org 128
z0:	dec 0
z1:	dec 0
z2:	dec 0
z3:	oct 20000		!Upper 8K bit
	bru inter,3		!Go to interrupt routine
	bss 1			!AAU trapping mode - overflow
itrap:bss 1			!AAU trapping mode - underflow
	bss 1			!AAU trapping mode - divide check
	bss 2			!AAU trapping mode index group
tx2:	bss 2			!Registers 2 and 3
!!Page 27

	stl			!Mailbox area
	ejt
!!Page 28
,     Mailbox zero flag is set to indicate
,     Datanet-30 message.
,     Return message also goes in mailbox 0
,     These messages [to D-30] are:
,        +1 Error, mbx1 tells what type
,           0 Temporary malfunction
,           1 No program
,           2 Unrecognizable system name
,        +2 Read done
,        +3 Write done
,        +4 Request dump
,     Messages used only after a dump from the D-30:
,        +5 Terminal exit
,        +6 Intermediate output
,        +7 Call for input

,     ******************************************
,     Special message switching mailbox
,     has the followind code:
,     +1 Disk request from 235
,     +2 235 finished with disk
,     +3 Request Datanet-30 to stop counting time
,     +4 Datanet-30 can start counting time again
,     +5 Not used at present
,     +6 Off
,     +7 On
,     -0 Acknowledge by D-30 and normal status
,     +10 Start batch
,     +11 Stop batch
,     Special request by a running system...
,     +12 Transfer ending disk address


mbx0:	bss 1			!Points to routine to be executed
mbx1:	bss 1			!Alfameric system name - first three letters
bmx2:	bss 1			!Starting disk address
mbx3:	bss 1			!Ending disk address and rel. loc. for LIST
	bss 2			!User number - or Selective LIST line number
	bss 2			!Problem name
mbx8:	bss 2			!Real time for Datanet-30

pmbx0:bss 2			!Special mailbox


,     Upon receipt of a message from the Datanet-30
,     The messages get moved into the saved mailbox
,     area, which follows:


smbx0:bss 1			!Saved message
smbx1:bss 1			!Saved system name
!!Page 29
smbx2:bss 1			!Saved starting disk address
smbx3:bss 1			!Saved ending disk address
smbx4:bss 1			!Saved user #, sel. LIST #, Teach address
smbx5:bss 1			!Saved ending Teach disk address
	bss 2			!Saved problem name
sdate:bss 6			!Date always kept here - used in billing
sclock: bss 4		!Billing time information

	stl			!Constants
	ejt
!!Page 30


,     Double-length constants

cov1:	oct 1777777		!Overflow-causing constant
	oct 1777777
cun1:	oct 2000000		!Underflow causer
	oct 2000001
edeof:oct 777755		!End of message mark
edfill: oct 777777	!Fill character.
.drmc.: spb drmc,1	!System disk usage entry
	z00 --		!filled in by executive
kfuge1:bru iplst		!Special regular mailbox entry delete constant
	dec wait-5		!Special for dexit
kxo:	dec mkx0		!Save index groups 0-4
	dec -20
movmbx: dec smbx1		!Mailbox 1, 2, 3, 4, 5, 6, 7 save
	dec -7
d15:	dec 15
	dec -1
trapr:dec itrap-1		!Trapping restore constant
	dec -7
traps:dec mktrp+1		!Trapping mode save constant
	dec -7
zero:	ddc 0
.effy.: spb effy,1	!Efficiency entry
	dec -1
.disk.: spb disk,1	!Dskop entry
	dec 0
.iras:bru 2			!Erase entry
	oct 0
.kbil.: sbp kbil,1	!Billing entry
	dec -1
.pty.:bnr			!Pty pointer
	spb pty,1

,     Constants

one:	oct 1
mone:	dec -1
two:	oct 2
mtwo:	dec -2
three:oct 3
four:	oct 4
five:	oct 5
six:	oct 6
seven:oct 7
o10:	oct 10
ten:	dec 10
o20:	oct 20		!Disk count stepping constant
!!Page 31
cr:	oct 37		!Carriage return
o40:	oct 40
o60:	oct 60		!Trailing blank...
o100:	oct 100		!Position step for disk addresses
o140:	oct 140		!96 records for disk
o200:	oct 200		!Buffer flip for dump routine
o300:	oct 300		!Illegal disk address test
o400:	oct 400
o440:	oct 440		!Fudge constants for scratch algorithm
8K:	oct 20000		!Upper memory relocation constant
mask1:oct 3777400		!For disk address checking
mask3:oct 3777770		!Message protect mask
mask4:oct 3760000		!Disk protect mask
mask6:oct 3000000
mask7:oct 3777700		!Edit mask
mask8:oct 0000077		!Edit mask
mask9:oct 3600000		!API mask
mask10: oct 3700000
mask11: oct 0077777	!Special P-counter mask
mask12: oct 0177777	!Special edit mask
bit3:	oct 200000		!Stacker full indicator on disk operations
bit4:	oct 100000		!Error indicator on disk operations
dinst:oct 10040		!Disk instruction less high order bits
dstakp: dec dstak-4	!Special disk fudge factor
kfudge: dec iprior	!Special dska fudge factor
mblnk:oct 2606060		!End of print line blank
ovflo:oct 1000000		!Overflow constant
sign:	oct -0
stwo:	oct -2
peom:	oct 55		!End of message for ptype routine
tend1:dec k3area-2	!End of program
nfl:	set nflpoint
unf:	set uflpoint
fix:	set fixpoint	!Set AAU modes

,     System table with disk addresses
,     Standard overlay is 3K, system is on fast
,     tracks and experimantal sys is on slow

sytab:bss 0
	alf BAS		!Basic
	oct 5000		!0  10  00
	oct 10540		!0  17  48
	alf ALG		!Algol
	oct 5400		!0  11  00
	oct 6140		!0  12  48
	oct 6540		!0  13  48
	oct 15400		!0  27  00
	alf FOR		!Fortran
	oct 13400		!0  23  00
	oct 14000		!0  24  00
!!Page 32
	oct 14400		!0  25  00
	alf DIP		!Dartmouth Interpretive Program
	oct 7000		!0  14  00
	alf TSA		!Time-Sharing Assembly processor
	oct 7400		!0  15  00
	oct 15000		!0  26  00
	alf XAL		!Experimental Algol
	oct 10000		!0  16  00
	oct 6000		!0  12  00
	oct 6400		!0  13  00
	oct 16000		!0  28  00
	alf XBA		!Experimental Basic
	oct 11000		!0  18  00
	oct 10400		!0  17  00
	alf XFO		!Experimantal Fortran
	oct 11400		!0  19  00
	oct 12000		!0  20  00
	oct 12400		!0  21  00
	alf EDI		!Edit system
	oct 13000		!0  22  00
last:	equ *-sytab		!Maximum number of entries in table
sexit1: bru sysex		!Exit branch
sexit2: oct 20000		!Exit constant [must have 8K bit set]
syloc:dec system		!Read-in location
mendt:oct 1400		!Move test constant
smove1: mov 0		!Move constant
wait1:dec wait		!Interrupt point test
h1:	oct 52140		!Time constants [21600 = 3600*6]
blzz:	alf & 00
h2:	oct 550		;[360 = 60*6]
colon:oct 150000
dumpbl: alf & & & 
k2loc:dec k2area		!2K area
k3loc:dec k3area		!3K area
k6loc:dec k6area		!6K area
k6area: eqo 4000		!6K area start
k2area: eqo 6000		!2K area start
k3area: eqo 12000		!3K area start
kermes: equ one		!Error answer
kmes2:equ two		!Normal answer for reads
kmes3:equ three		!Normal answer for writes
kmesd:equ four		!Request dump
kmest:equ five		!Terminal exit message
kmeso:equ six		!Intermediate output message
kmesi:equ seven		!Real-time input call message
bit1:	equ ovflo		!Parity error indicator
hdreq:equ one		!Disk request message
exec1:eqo 34000		!First part of 235 executive
exec2:eqo 36000		!Second part 235 executive
imer:	oct -10

!!Page 33
,    Edit constants

rog:	equ k3loc
rog2:	equ k2loc
tend:	equ k3loc
edsf:	equ o100
edpnt2: dec smbx4		!Points to selective list number
$edig:equ mask12		!Edit mask 0177777
edtwo:equ mtwo
edmsk1: equ mask7		!oct 3777700
edmsk2: equ mask8		!oct 0000077
edcarr: equ cr		!Carriage return
upper8: equ 8K
table:eqo 4000		!Start of edit linkage table

	stl			!Time-sharing typewriter options
	ejt
!!Page 34

com:	bss 0			!List of options available on typewriter
	oct 623700		!Stop - same as crump
	bru icrump,3
key:	equ *-2		!Key to catalogue
	oct 3160		!0  6  56

	alf OFF		!Off tells the D-30 to stop counting time
	bru ioff,3
summry: equ *-2		!Time-sharing operations efficiency summary
	oct 3540		!0  7  48

c/p:	alf C/P		!Lister
	bru perget,3
	oct 3100		!0  6  32

c/c:	alf C/C		!Reproducer
	bru perget,3
	oct 3120		!0  6  40

sys:	alf SYS		!System loader
	bru perget,3
	oct 3140		!0  6  48

cat:	alf CAT		!Catalogue printout
	bru perget,3
	oct 3200		!0  6  64

dum:	alf DUM		!Disk dump
	bru perget,3
	oct 3220		!0  6  72

loa:	alf LOA		!Disk loader
	bru perget,3
	oct 3240		!0  6  80

bil:	alf BIL		!Billing pack program
	bru perget,3
	oct 3260		!0  6  88

dbg:	alf DBG		!Debugging overlay
	bru perget,3
	oct 3500		!0  7  32

g/p:	alf G/P		!GAP lister
	bru perget,3
	oct 3520		!0  7  40

s/o:	alf S/O		!Sysout lister
	bru perget,3
	oct 3620		!0  7  72
!!Page 35

batch:alf BAT		!Bacground processor
	bru perget,3
	oct 3560		!0  7  56

c/t:	alf C/T		!Card to tape
	bru perget,3
	oct 4200		!0  8  64

cru:	bss 0
oba:	alf OBA		!Special batch system overlay
	bru *			!Will never come here
	oct 4100		!0  8  32
tap:	equ *-2		!Tape read/write subroutine
	oct 3640		!0  7  80
ocat:	equ *-2		!Batch Systems catalogue
	oct 3660		!0  7  88
bat2:	equ *-2		!Background part 2
	oct 3600		!0  7  64


	stl			!Error messages
	ejt
!!Page 36

tmm:	equ zero		!Temporary malfunction message
npr:	equ one		!No program message
usn:	equ two		!Unrecognizable system message

datnet: bss 0		!D-30 kept disk
	oct 372403
	oct 3755

dc:	bss 0			!Disk controller
	oct 372431
	oct 624237
	oct 557777

dp:	bss 0			!Parity
	oct 473755

ilg:	bss 0			!Illegal
	oct 313755

adrs:	bss 0			!Adrs xxxxxx
	oct 372160
adr1:	alf & & & 
	alf & & & 
pcr:	oct 375577

mssage: bss 0		!Message
	oct 443755

full:	bss 0			!Full
	oct 372643
	oct 433755

del:	bss 0			!Deleted
	alf & DE
	alf LET
	oct 252437
	oct 557777

rea:	bss 0			!Ready
	oct 375125
	alf ADY
	oct 333755

bzy:	bss 0			!Busy.
	oct 372264
	alf SY.
	oct 375577

ilr:	bss 0			!Illegal task
	oct 373232
!!Page 37
	oct 323755

	stl			!Efficiency summary and buffer areas
	ejt
!!Page 38

,     Efficiency summary of systems operations



	loc 600		!One 64-word record
fclock: bss 1		!Starting time
flapse: bss 1		!Elapsed time
fstim:bss 2			!Actual time of start
fcnt:	bss 1			!Half-hour counter
	bss 5			!Save 5 locations on principle
f4:	bss 0
	bss fkbat-f3
f2:	bss 0
,     Day accumulators
acstrt: bss 1
acrun:bss 1
acswap: bss 1
acdisk: bss 1
acbat:bss 1			!Accumulated batch
astim2: bss 2		!Start for accumulated storage
ftem:	bss 4			!Temporary storage

f1:	equ flapse



	loc 1000
io1:	bss 84		!Buffer area no. 1
	loc 1200		!Second buffer area
io2:	bss 84		!Buffer area no. 2

,     Sysout buffer areas
	loc 600
sio1:	bss 80		!80 words
sio2:	bss 40		!40 words
sio3:	bss 40		!40 words
sio4:	bss 111		!110 words + 1 residue word
sio5:	bss 111		!110 words + 1 residue word
	bss 1			!Just to see how far I am


,     Disk addresses to be used at load time only
	loc 2000
oba2:	equ *-2		!More of batch system overlay
	oct 4140		!0  8  48
oba3:	equ *-2		!More batch
	oct 4120		!0  8  40
oba4:	equ 4160		!Still more
	oct 4160		!0  8  56

!!Page 39
	stl			!Save area
	ejt
!!Page 40


,     The save area is used to save all
,     the important registers and index groups 0-4
,     when a program is temporarily dumped on the
,     disk.

	loc 4000
kclock: bss 1		!Adjusted starting time for systems
mkprnt: bss 1		!System output area pointer
mksxg:bss 1			!Index group save - TEACH flag
ilngth: bss 1		!Length of source program in memory
mkdisk: bss 1		!Starting address of 6K area
	bss 1			!Blank for now
mkaq:	bss 2			!A and Q registers save
mkov:	bss 1			!Overflow save
mkp:	bss 1			!P-counter save
mkx0:	bss 20		!Index groups 0-4 save
mkax:	bss 2			!AX register save
mkqx:	bss 2			!QX register save
mode:	bss 2			!AAU mode and indicator save
mktrp:bss 6			!Trapping mode flag and branch save
mktx2:bss 2			!Trapping mode index register 2 save
movid:bss 1			!Overlay identifier #
morep:bss 1			!Number of current replacement
molen:bss 1			!Length of overlay
momem:bss 1			!Memory location of overlay
movint: bss 1		!Flag to indicate whether read completed
clock:bss 1			!Elapsed time counter
mdc:	bss 1			!Dump code for D-30
mdl:	bss 1			!Dump length starts at 96 records
mkpr1:eqo 4100		!System output buffer

system: eqo 20000		!System read-in area
sname:equ system+4	!Alfameric system name

	stl			!Interrupt routine
	ejt
!!Page 41  9/27/02

,     When not performing any specific
,     task, the executive sits in its wait loop,
,     displaying a distinctive pattern in the
,     A register.


	loc 34001
wait:	sxg 5
	spb time,2		!Get time
	dst mbx8		!and give to Datanet-30
	set pst		!If in interrupt mode, exit
	set trpmode		!If in trap program, exit
	set ntpmode		!with no trap set
	ldx 8K,3
	bru *+1,3
	bno			!Turn off overflow indicator
	nop
	lac
	cab int1		!Check if 1 second elapsed
	bru *+4		!No
	oct 2506014		!Yes, interrupt
	add four		!Set timing interval for 2/3 seconds
	sta int1
	cab itim		!Check if 1+minute elapsed
	bru *+2		!If less, do nothing
	bru wait		!If so, pick up time again
	cab .eff		!Check if efficiency save due
	bru *-10
	bru *-11
	set pbk		!Ten minutes elapsed, save
	lda cov1		!Make sure no more called until completion
	sta .eff
	dld .effy.
	spb insert,2	!Insert task in list
	bru wait+3		!and get back
	ejt
!!Page 42
,     Inter saves the working registers, and
,     first looks at the regular mailbox.  If this
,     is positive, it goes through the regular
,     mailbox and then the peripheral mailbox
,     task tables in turn.
,     If the regular mailbox was negative, ireg
,     isolates the low order end and performs
,     a table lookup with the result.



	oct 0
	ddc 0			!Make sure itab is even
	bss -3
inter:dst save		!Save A and Q
	bov			!Turn off overflow indicator
	bru *+1
	stx pct,1		!and save P-counter
	lda mbx0		!Look at regular mailbox
	bmi			!Check if negative
	bru ireg		!If so, go service it

,     ******   WARNING...iprior must be even ******

iprior: bru *+2		!Priority task entry
	oct 0

iplst:bru *+2		!0
	oct 0

	bru *+2		!1
	oct 0

	bru *+2		!2
	oct 0

	bru *+2		!3
	oct 0

	bru *+2		!4
	oct 0

	bru *+2		!5
	oct 0

	bru *+2		!6
	oct 0

	bru *+2		!7
	oct 0
!!Page 43 9/27/02

	bru ispmbx		!Last entry
	oct 0
eplst:equ *			!End of list
eplen:equ *-iplst		!List length


ispmbx:lda pct		!Check P-counter
	bmi			!If plus, then TON set
	bnn			!so crump
	bru irest+1
	ldx ty1,1		!Restore register 1 !!Word counter
	ldx ty2,2		!and 2  !!Character counter
	sna 19		!Get character
	ext sign		!and get rid of a sign
	lqa			!Keep a copy in Q
	cab mask8		!Check for line delete
	bru *+2
	bru indel		!Delete line
	inx 1,2		!Increment character counter
	bxh 3,2		!and check if over word
	ldx 8K,2		!Yes
	stx ty2,2		!Save
	bru *+1,2		!Code for characters as follows
	bru inr		!Rightmost is 0
	bru inl		!Leftmost is 1
	sla 6			!Middle is 2
	ory ty,1		!Save middle character in word
	bru inchar		!and check for carriage returns
inl:	sla 12		!Get character into word
	sta ty,1
	bru inchar
inr:	ory ty,1		!Rightmost character
	inx 1,1		!Increment word pointer
	stx ty1,1		!and save


inchar:laq			!Get character
	sub cr		!Check for carriage return
	bze
	bru ianaly		!Yes, analyze command
	bxl 20,1		!Check status of one
	bru irest


indel:spb messg,2		!DELETED message
	dec del
indelx: ldz			!Reset pointers
	sta ty1
	sto ty2
	bru irest		!and get out
!!Page 44


ibusy:sbp messg,2		!Type message
	dec bzy		!BUSY
	bru indelx		!and get out


ianaly: sta ty1		!Reset pointers
	sto ty2
	sta z2
	inc com,2
	lda ty		!and analyze command
ianalz: cab 0,2
	bru *+2
	bru 1,2		!Go to task
	inx 3,2		!Step pointer
	bxl cru,2		!Check for end of list
	bru ianalz


ild:	spb messg,2		!Type message
	dec ilr		!Illegal task
	bru irest		!and crump


ioff:	lda three		!Stop time count
	bru *+2
icrump:lda four		!Ask for time count again
	spb spmess,2
iredy:spb messg,2		!Type READY message
	dec rea
	ldx ovtsk,1		!Check if task used at all
	bxh 1,1
	spb irase,2		!If greater than 1, then used
iresp:ldz			!Reset various pointers
	sta ovtsk		!Reset pointer
	sta bzyf		!and turn off busy flag
	sta cmessb		!Reset batch flag
	sta io1		!for batch front card search
	sta kbfdg,3		!Fix billing
	sta kbfdg+4,3


irest:lda pct		!Restore P-counter
	sta z1
	bov			!Make sure overflow is not on accidentally
	bru *+1
	ext mask9		!and get rid of high order bits
	sla 4			!Restore overflow
	dld save		!Restore A and Q
	set pst
!!Page 45
	bru 0,1		!Return


irase:dld .ipas		!Entered on 2 with pointer to be erased
	add z1		!in register 1.  Construct bru *+2 and
	ext 8K		!make for bank-compatible addresses
	dst 0,1		!Delete entry
	bru 1,2		!And return


insert:sta .ins		!Save entry.  Insert sets up tasks for
	ldx zero,0		!API time
	ldx eavail,3	!Get next available location pointer
ins1:	inx 2,3		!Actually is last available
	bxh eplst,3		!and check for wraparound
	ldx einit,3		!Yes, re-initialize
	stx eavail,3	!Save pointer
	inx 2,0		!Count
	bxh eplen+2,0	!and check for end of table
	bru inful		!Yes
	lda 1,3		!Check if entry free
	bnz			!Entries have second word non-zero
	bru ins1		!Not free, keep searching
	lda .ins		!Yes
	dst 0,3		!and set entries in list
	oct 2506014		!Make sure it gets serviced soon !!set prq
	lda eavail		!and set pointer in A
	ldx 8K,3		;Reset register 3
	bru 1,2		;and scram
inful:ldx 8K,3		!Restore 8K bit
	ldx eavail,1	!and get entry being looked at
	spb irase,2		!Crump some task or other
	sbp messg,2		!and give room to output message
	dec full		!Should never happen
	bru irest		!and of course crump task


ireg:	sta smbx0		!Save message
	cab imer		!Check for illegal message
	bru *+3
	bru *+2
	bru mer		!Message error
	add 8K		!Add upper 8K bit
	sta z2		!Set up for indexed branch to task
	stx preg,1		!Save P-counter for kdump
	dld kfuge1		!Get special erase entry
	dst iprior,3	!and set in regular mailbox task entry
	lda wait1		!and set P-location for exit
	sta pct
	lac			!Save time
	sta isum
!!Page 46
	dld movmbx		!Save mailbox 1, 2, 3, 4, 5, 6, 7.
	mov mbx1
	sta mbx0		!Aknowledge message received
cbuga:bru *+1,2		!And branch according to mailbox number
	bru kedit		!0
	bru kstart		!1
	bru kcntnu		!2
	bru kdump		!3
	bru kdskrd		!4
	bru kdskwr		!5
	bru kteach		!6
	bru kbrun		!7
	bru ktrrun		!10


mer:	spb adrser+1,2	!Message error
	dec mssage
	bru erxtmm

	stl			!Edit
	ttl			!Executive routines
!!Page 47


,     EDIT - message 0
,     1) Read variable-length source program from
,        teletype standard area into upper [3K]
,        area of memory.
,     2) Edit source program into lower [2K] area
,        of memory.
,     3) Write variable-length source program onto
,        teletype standard area from lower [2K]
,        area of memory.
,     4) Place 2*length into mbx1, starting disk
,        address [selective list] into mbx2.
,     Normal answer = 2


,     EDIT reorders a source program according
,     to the line numbers which precede each
,     statement.
,          A linked list is constructed, each entry
,     in the list corresponding to one statement
,     and consisting of four words, as follows
,     1)  location of first word of each statement
,     2)  length of statement in two's complement
,     3)  statement number in binary
,     4)  relative address of link with next
,         highest line number.
,     EDIT moves the source program down to
,     6000 octal, ordering it according to
,     the list.



kedit:bss 0
	spb upread,2	!Read source program into upper area
	sxg 0		 	!Set group zero for edit
	set pst	 	!and exit priority mode
	bru edita,3


kwrt:	spb lwwrit,2	!Write source program from lower are
	bru kexitr


edit1:mpy ten		!Convert character
	bru echar		!and get next

edita:dld zero		!Selective list pickup
	sta mbx3		!Set relative location to zero
	lda smbx4		!Check first character for digit
	ext $edig		!Extract all but high order zone bits
!!Page 48
	bnz
	dld edeof		!If first character not a digit, set to fills
	ldx edpnt2,1	!Set pointer
	spb echar1,3	!Get character
	cab ten		!Check if digit
	bru edit1		!Yes, convert
	bru *+1		!No, crump
	laq			!Get converted digit
	sta eselec		!and save
	lda smbx2		!Pick up starting disk address
	ext one		!Mask off extraneous bits
	sta eselec+1	!and save
	lda ilngth		!Pick up program length
	sla 6			!Computer number of words to multiple of 64
	add rog		!!This needs a comment--what is it doing?
	add mone
	sta xr01		!Last word of last record - odd location
	ldx four,2		!Initialize table pointers
	ldx zero,3		! and other registers
	lda mone		!Initialize table entries
	sta table
	lda edfill		!Large number
	sta table+2


edbob:lda xro1		!Begin search for carriage returns
	add edtwo		!which must be in an odd location
	sta xr01
	bxl k3area,1	!Check for no carriage returns at all
	bru enpr		!No-program exit
	lda 0,1		!Proceed down through program
	ext edmsk1
	cab edcarr
	bru edbob
	bru edkar		!Carriage return
	bru edbob


edkar:stx edy,1		!Address of CR at end of statement
edbla:lda xr01		!Proceed down through program
	add edtwo		!for next carriage return
	sta xr01
	bxl k3area,1	!Has end of program been reached...
	bru edblax		!Yes
	lda 0,1
	ext edmsk1		!Look for CR at end of next previous
	cab edcarr		!statement
	bru edbla
	bru edblax
	bru edbla
edblax:stx edt,1		!Address of CR at end previous statement
!!Page 49
	inx 1,1
	lda 0,1		!Is word after CR an end-of-message
	cab ededof
	bru edblay
	bru *+2
	bru edblay
	lda xr01
	add edsf		!Increase XR-1 to next multiple of 64
	ext edmsk2		!  (to beginning of statement following
	sta xr01		! end-of-message)
edblay:lda xr01
	sta table,2		!Address of first word of statement
	sub edy
	add mone		!Get two's complement of correct length
	sta table+1,2	!Number of words in statement
	lda 0,1		!Get first character of line number
	ext $edig		!and check it
	bze
	bru edig		!Digit
	lmo
	sta table+1,2
	bru enless		!and set as smaller number


edig1:mpy ten		!Convert digit !!Duplicate code
	bru echar		!and get next


edig:	sxg 1			!Set index group 1
	dld zero		!Initialize register and Q
	xr10
	ldx xr10,1		!Set pointer
	spb echar1,3	!Get character
	inx 1,0		!Count
	bxh 6,0		!Test
	bru edigx		!Crump if done
	cab ten		!Check for digit
	bru edig1		!Yes, convert
	bru *+1		!No
edigx:sxg 0			!Reset index group
	laq			!and get converted line number
	sta table+2,2	!Statement number in binary
	cab table+2,3	!Is new statement higher or equal
	bru enless		!Less
	bru edout		!Equal
	sta edz		!Save line number and start adjusting links
	stx edy,3		!Next lower group in list
	lda table+3,3
	sta xr01		!Next higher group in list
edigy:lda edz
	cab table+2,1	!Does the new statement fit between these
!!Page 50
	bru edigz		!two groups
	bru edout
	stx edy,1		!Next lower in list
	lda table+3,1
	sta xr01
	bru edigy
edigz:lda xr01		!Link new group to higher
	sta table+3,2
	ldx edy,1		!Group just below new one
	lda xr02
	sta table+3,1	!Link lower group to new one
	bru enlesx
enless:lda xr03
	sta table+3,2	!Address link of next higher group in list
	ldx xr02,3		!Change pointer to lowest statement in list
enlesx:inx 4,2		!Next entry group in table


edout:bxh 1024,2		!256 statements maximum
	bru edoutx
	lda edt
	cab rog		!Has end of program been reached
	bru edoutx
	bru *+1
	ldx edt,1		!CR at end of next statement to
	bru edkar		!  be listed
edoutx:ldx xr03,2		!Initialize, begn rewrite
	lda rog2
	sta edt
	ldx upper8,3


edgurk:lda table,2
	bmi			!If last group in list, prepare to exit
	bru edsout
	sta xr11
	lda table+1,2
	cab edtwo
	bru eslec
	bru *+2
	bru edelet		!Delete if length is -1
	sxg 1			!Set index group 1
	spb echar1,3	!and get character
	cab ten		!Is it a digit
	bru echar		!Get next if so
	bru *+1		!Reset index group
	sxg 0			!  As here either delete or exit
	ext o40		!  get rid of bit
	cab cr		!  and check if done with line number
	bru eslec		!  No, do not delete
	bru edelet		!Delete
!!Page 51

,     Selective LIST feature

eslec:lda table+2,2	!Check line number against list parameter
	cab eselec
	bru go		!If less than selec number, then get out
	bru *+1		!Check special case of first nubmer
	lda edt		!Location of line # of current statement
	ext mask7		!Get rid of all but position mod 64,
	sta mbx3		!then set relative position in record for D-30
	lda edt		!Get address of line number again
	ext edmsk2		!and get rid of relative part
	sub rog2		!Compute how many records from start we are
	sra 5
	add eselec+1	!Add starting address
	sta eselec+1	!and save to send over to Datanet-30
	lda edfill		!Take care of special selec case
	sta eselec		!Crump selective LIST


go:	dld table,2		!Set up move instruction to
	sto *+2,3		!sequentially position program in new area
	lda edt
	mov --		!Dummy move instruction
	xaq
	neg
	add edt
	sta edt		!Compute next area to be filled
	cab tend		!Check for program toolong
	bru edelet		!OK, continue
	bru *+1		!No, trim it down
	lda tend1		!Two words
	bru edsout+1	!and crump


edelet:lda table+3,2
	sta sr02		!Go to next higher instruction
	bru edgurk


edsout:lda edt		!Edsout computes length of program
	sta xr01		!Filling begins here
	bxl k2area+1,1	!Also check for no program
	bru enpr		!If none, crump
	add edsf		!Prepare to fill in last buffer load
	ext edmsk2		!(to next multiple of 64)
	neg			!Construct end-of-fill test
	sto eds1,3
	neg			!Re-negate
	sub rog2		!Compute length
	sra 5			!for Datanet-30
!!Page 52
	sta mbx1
	sra 1			!and for TEACH
	sta ilngth		!Save length in pointer
	dld edeof		!Pick EOM and fill
	dst 0,1		!Put away
	laq			!Double fills
eds0:	inx 2,1		!Increment pointer
eds1:	bxh *,1		!Test
	bru eds2		!If done, crump
	dst 0,1		!Fill out
	bru eds0
eds2:	lda eselec+1	!Starting disk address
	sta mbx2		!Give to Datanet-30
	lda .kwrt.		!Get entry
	sta iprior,3	!and set in entry for D-30 tasks
	set prq		!and priority request
	bru wait		!and get out

,     Character picking routine - places one at a
,     time in the A-register

echar:bxl 2,2		!Check if first character coming up
	bru ech23		! characters 2 or 3
echar1:ldx zero,2		!Entry point first time - set counter
	lda 0,1		!Get word
	inx 1,1		!  and step pointer
	sta ech3		!Rightmost character
	sra 6
	sta ech2		!Middle character
	sra 6			!High order
echar2:ext mask7		!Extract high-order bits
	bru 1,3		!and return
ech23:lda ech2,2		!Get next character
	inx 1,2		!Step pointer for characters
	bru echar2		!and exit


enpr:	lda npr		!No program
	bru erex		!!Error exit

	stl			!KSTART and KCNTNU
	ejt
!!Page 53 9/28/02


,     KSTART - message 1
,     1) Read system, if necessary, into 20000
,     2) Start RUN
,     Normal answers to Datanet-30...
,        4 - Request dump
,        5 - Terminal exit
,        6 - Intermediate output
,        7 - Call for input



kstart:bss 0
	dld zero
	dst movid		!Initialize replacement and overlay indicators
	lda kmeso		!Set dump code for time dump
	sta mdc
	lda o140		;and set dump length to 96 records
	sta mdl
	lda smbx2		;Save disk address
	sta mkdisk
	lac			;Get starting time
	dst sclock		;Set time and flag
	sta kclock		;Set clock for systems
	spb syread,2	;Read in system...
	spb relin,2		;and relinquish disk if necessary
	rin			;Turn off bad lights
	set pst		;and interrupt mode
	bru system+1,3	;and exit (to system)



,     KCNTNU - message 2
,     1) Read in 6K swap from teletype 6K area.
,     2) Read system, if necessary, into 20000.
,     3) Begin run where last interrupted
,     Normal answers to Datanet-30...
!!***************************************************
!!JSM: Comment error: the comments below had not been
!!updated to reflect a revised program termination
!!protocol; I modified them to match the comments
!!associate with 'kstart', above, and deleted a blank
!!line to keep the line numbering intact.
!!***************************************************
,     4 - Request dump
,     5 - Terminal exit
,     6 - Intermediate output
,     7 - Real-time input call


kcntnu:bss 0
	lac			;Set time for billing
	dst sclock
	lda smbx3		;Get length
	sto *+2,3		;and save for read
	spb dska,2		;and read in 6K from teletype 6K area
	z12 96		;Read, 96 records
!!Page 54
	dec k6area		;into 4000 - 6K area
	z20 smbx2		;Indirect to address
	bru erxtmm		;Error return
	spb syread,2	;Read in system
	spb relin,2		;Relinquish disk
	spb ksuma,2		;Get elapsed time for 6K swaps
	lda kmeso		;Set dump code for time dump
	sta mdc
	set fixpoint	;For trap work
	lda 8K		;Set register for trap group
	sta tx2+1
	lda .krst.		;Set for trap
	sta itrap-1
	sta itrap
	sta itrap+1
	set ntpmode		;Set no-trap mode
	ldx mktrp,1		;Get condition of trapping group
	bru *+1,1		;and go to branch table
	bru krtrp		;Trapmode set and in trap program
	bru krtri		;Not in trap program when interrupt occurred
,     Trap not set so fall through

kcrest:spb khold,2	;Restore hold indicators
	lda kx0+1		;Restore index registers
	maq
	mov mkx0
	sta mkprnt		;and reset output pointer
	lac			;Adjust clock to give
	sub clock		;correct starting time to system
	sta kclock		;(without swap time)
	dld trapr		;Restore trap contents
	mov mktrp+1
	lda mode		;and restore AAU mode
	sta *+1,3
	set nflpoint	;Dummy...
	fld mkqx		;Get QX register
	lqa ,a		;and restore
	fld mkax		;Restore AX resgister
	dld mkaq		;Prepare to restore A and Q
	dst save
	ldx mksxg,1		;and restore old index group
	oct 2526013		;*** sxg 0,1 ***
	lda mkov		;Isolate overflow bits
	ext mask11
	add mkp		;and get P-counter location
	bru irest+1		;Then exit to system


krtri:spb khold,2		;Trap mode set, but program not in trap when
	set trpmode		;exit occurred
	bru kcrest+1	;and get out
!!Page 55

krtrp:set trpmode		;In trap when interrupt occured
	fdv zero		;Cause trap
	bru irest		;and exit so trap can take place

krst:	rin			;Reset indicators - entry is here from self-
	lda .krex.		;caused trap
	sta iprior,3	;so set for later interrupt
	set prq		;then interrupt this trap

krex:	spb irase,2		;After above interrupt, erase entry that
	bru kcrest		;called here, and go finish process


khold:ldx mode+1,1	;Get type of hold condition to be restored
	bru *+1,1
	bru 1,2		;None
	bru kcov		;Overflow hold on
	bru kcun		;Underflos hold on
	fdv zero		;Divide check on - recreate it
	bru 1,2		;and exit

kcov:	fld cov1		;Overflow hold on
	fad cov1		;Restore it
	bru 1,2		;and exit

kcun	fld cun1		;Underflow indicator on
	fad cun1		;Restore it
	bru 1,2		;and exit

	stl			;KDUMP
	ejt
!!Page 56


,     KDUMP - message 3
,     1) Checks mdc to see what type of dump is
,        required.  If it is a terminal exit it
,        goes to koutpt.  If not,
,     2) Saves all program working registers in a
,        64-word block at the beginning of the 6K
,        area.
,     3) Checks dump length and dumps the required
,        number of words.
,     4) Puts running time in mbx1.
,     5) Intermediate output flag for D-30 in mbx2.
,     6) Dump length in mbx3.
,     7) Writes billing record
,     8) Gives D-30 type of dump in mbx0
,        6 if intermediate output
,        7 if real-time input



kdump:bss 0
	lda mdc		;Check dump code
	sub six
	bmi	
	bru koutpt		;Terminal exit only needs 1K dump
,     Start regular dump procedure
	dld save		;Save A and Q registers
	dst mkaq
	lda preg		;get P-counter
	sta mkov
	ext mask10		;Get rid of high-order bits
	cab wait1		;and check where interrupted...
	sta mkp		;In program
	bru *+1		;In executive
	dld kx0		;Save index groups 0-4
	mov 0
	oga			;Get index group
	sta mksxg		;and save index group with instruction
	ldx mkprnt,1	;Store end-of-message
	lda edeof		;in output area according
	sta mkpr1,1		;to program pointer
	lac			;Compute total adjusted elapsed time
	dst sclock+2	;Give ending time and set flag for kdump
	sub kclock
	sta clock		;and save
	maq			;and put total # of seconds
	dvd six
	sta mbx1		;in mailbox 1 for Datanet-30.
	spb ksumb,2		;Get time for program run
	dld traps		;Save contents of trapping mode locations
!!Page 57
	mov itrap-1
	sta xr52		;and initialize for later test
	sta movint		;Set flag to indicate interrupt occurred
	lda .ktrs.		;Branch to check simultaneous interrupts
	sta tx2
	lda .ktrs]		;spb tx2,0
	sta itrap+1		;and set in trapping mode locations
	sta itrap
	sta itrap-1
	lda 8K		;Set register 3 to 8K bit
	sta tx2+1
	fst mkax		;Save AX register
	laq ,a		;and move QX to AX
	fst mkqx		;and save QX
	lda nfl		;Save AAU mode of operation - assume normalize
	bar bup,7		;Check for un-normalized
	lda unf
	bar bfx,7		;Check for fixed point
	lda fix
	sta mode		;and save mode of operation
	ldz			;Save hold indicators - zero if none
	bar boo,7
	ldo			;Overflow hold on
	bar buo,7
	lda two		;Underflow hold on
	bar bdc,7
	lda three		;Divide check on
	add 8K		;and set upper bit
	sta mode+1
	sxg 5			;Set index group for executive use
	set pst		;and exit priority mode
	bru *+1,3		;If there was a simultaneous trap, the program
	spb *+1,2		;will transfer to ktrs, else will go here
	lda xr52		;Check to see if in middle of trap program
	bnz
	bru ktrchk		;Not in trap program, go check if trap set


,     ktex sets a flag for cntnu as follows...
,     0 - Program running trap group when dump
,         command was given,
,         or trap occurred simultaneously with API
,     1 - Not in trap program, but trpmode set
,     2 - Trap mode not set


ktex:	add 8K		;Set upper 8K bit on for branch table
	sta mktrp		;Set flag - 8K if dropped through
	rin			;Reset any indicators we may have turned on
	lda .kset.		;Set entry for later disk work
	sta iprior,3
!!Page 57
	set prq		;Set priority request
	bru wait		;and go to wait loop


ktrs:	lda preg		;Simultaneous occurrence of trap and interrupt
	sta mktx2-1		;Set trap register 1 appropriately
	lda tx2-2		;Get entrance
	ext mask10		;Get rid of high order
	sta mkp		;Set for return
	ldz			;Set indicator for cntnu
	bru ktex		;and exit


ktri:	ldo			;Trap mode set, but not in trap program
	bru ktex		;exit


ktrchk:lda .ktri.		;Test for trapmode set
	sta itrap+1		;If set, a branch to ktri will occur, else
	set fixpoint	;try and insure fdv will work ok
	fdv zero		;the program will continue
	lda two		;Trapmode not set
	bru ktext		;exit


,     kset sets up the billing for one-shot usage,
,     and then writes the 6K area onto the disk


kset:	spb kbill,2		;Set up to bill
	lda mdl		;Get dump length
	sto *+3,3		;and put in list
	sta mbx3		;also send to D-30
	spb dska,2		;Write on disk
	z37 96		;Write, 96 records
	dec k6area		;from 4000 (6K area)
	z20 mkdisk		;indirect to disk address
	bru erxtmm		;Error exit
	bru kexitd		;Dump exit


,     kexitd picks up the output area pointer and
,     sends it to the D-30 as an output flag.  It
,     also puts the dump code in A for kexit

kexitd:lda mkprnt		;Get output area pointer
	sta mbx2		;Send to D-30
	lda mdc		;Dump code
	bru kexit		;and exit

	stl			;KOUTPT, KDSKRD, KDSKWRT
!!Page 59
	ejt


,     KOUTPT - entered through KDUMP
,     1) Dump output area onto first 16 records
,        of teletype standard area
,     2) Write terminal billing record
,     Normal answer...
,       5 - terminal exit


koutput:lac			;Set total elapsed time for terminal billing
	sta sclock+2
	sub kclock		;Subtract adjusted starting time
	sta sclock+3	;Total elapsed time for billing record
	spb ksumb,2		;and get program running time
	spb kbill,2		;and set up for billing
	spb dska,2		;Now write on disk
	z37 16		;Write, 16 records
	dec k6area		;from 4000 (also output area)
	z20 mkdisk		;indirect to address
	bru erxtmm		;Error exit
	bru kexitd		;Dump exit



,     KDSKRD - message 4
,     1) Read variable-length source program from
,        specified address into lower (2K) area.
,     2) Place 2*length in mbx1
,     Normal answer...
,       2 - read completed


kdskrd:spb lwread,2	;Read into lower area
	lda ilngth		;Get length
	sla 1			;and multiply by two
	sta mbx1		;and set in mailbox 1
	bru kexitr		;Done



,     KDSKWR - message 5
,     Write variable-length source program onto
,     specified address from lower (2K) area
,     Normal answer...
,       3 - write completed


kdskwr:spb lwwrit,2	;Write from lower
	bru kexitw		;and terminate
!!Page 60

	stl			;KTEACH
	ejt
!!Page 61


,     KTEACH - message 6
,     1) Read in testing program from address
,        specified
,     2) Read system, if necessary, into 20000
,     3) Start run
,     Normal answers...same as for START



kteach:lda ilngth		;Get end of tested program, and compute
	sla 6			;where testing program is to go
	add k2loc		;Step past 6000
	sta ktea2+2,3	;and set memory address in parameter list
	lda smbx5		;Get length of testing program
	sub smbx4
	sra 1			;Correct to number of 64-word records
	sto ktea2+1,3	;and set in parameter list
	add ilngth		;Get combined length for teach
	add sign		;Set flag for teach
	sta mksxg

ktea2:spb dska,2		;and pull in program
	z12 --		;read, constructed length (variable)
	dec 0			;constructed address (memory)
	z20 smbx4		;indirect to disk address
	bru erxtmm		;Error exit
	bru kstart		;and pull in system


,     KTBRUN - message 10
,     1) Run teletype batch
,     Normal answer ... 0
ktbrun:bru *

	stl			;Normal and error exits
	ejt
!!Page 62  9/29/02


,     Both exists relinquish the disk and send
,     a completion message to the Datanet-30, as
,     follows...

,     1 - error message, sent through erxtmm
,     2 - read completed, sent through kexitr
,     3 - write completed, sent through kexitw



erxtmm:spb irec,2		;Dump debugging locations on tape
	lda tmm		;Temporary malfunction message
erex:	sta mbx1
	lda kermes		;Error message
	bru kexit		;and send


kexitr:lda kmes2		;Message 2
	bru kexit

kexitw:lda kmes3		;Message 3
kexit:sta kanswr		;and save
	spb relin,2		;Relinquish disk
	spb ksuma,2		;and get routine elapsed time
	lda mbx0		;Try not to wipe out D-30 message
	bpl
	lda kanswr		;OK, send it
cbugb:sta mbx0		;None, so send answer over
	cab kermes		;Check if error exit
	bru iplst		;No
	bru wait		;Yes, special exit
	bru iplst		;No, continue normal running

,     Elapsed time calculating routines

ksuma:ldx smbx0,1		;Get elapsed time for called routine
	lac
	sub isum		;Subtract starting time
	add fkedit,1	;and step particular counter
	sta fkedit,1
	bru 1,2		;and return


ksumb:lac			;Get elapsed time for program runs
	sub sclock		;Starting time set by Continue and Start
	add fkstrt		;Step running time counter
	sta fkstrt
	bru 1,2		;and return

!!Page 63

,     Users will be billed according to the
,     amount of central processor time they
,     use.
,     The time portion of the billing record
,     is broken up as follows...
,     1) sclock    Starting time for a run
,     2) sclock+1  Flag, set as follows...
,                  0 for a first run
,                  non-zero otherwise
,     3) sclock+2  Ending time for a run
,     4) sclock+3  Flag, set as follows...
,                  Elapsed time if terminal run
,                  Negative number if 6K dump


kbill:lda swflg		;Check for stacked-up bills
	bod
	bru 1,2		;Yes, crump this one
	ldo			;Set flag on
	sto swflg
	dld .kbil.		;Set entry to bill this particular clunk
	bru insert		;and return

kbil:	bcs btn,1		;Check if tape ready
	bru 2,1		;Crump if not
	ldz			;Set batch tape error flag
	sto swflg		;Reset flag
	spb irase,2		;Erase entry
kbdfg:nop			;Branch to tape op overlay if in
	sel 1			;and write billing record
	wtb smbx1,0
	    %24		;Short record
	nop
	bru iplst		;and go to API list


	stl			;UPREAD, LWREAD, LWWRIT
	ttl			;Utility routines for source input/output
!!Page 64

,     Upread reads a source program from the
,     teletype standard area into upper (3k) area
,     of core memory.


upread:lda k3loc		;Get memory address for 3K area
	bru kreada		;and go read



,     lwread reads a source program from the
,     teletype standard area into lower (2K) area
,     of core memory.


lwread:lda k2loc		;Get memory address for 2K area
kreada:sta kreadb+2,3	;Set in parameter list
	stx kret,2		;and save return location
	lda smbx3		;Ending disk address
	sub smbx2		;Subtract starting disk address
	sra 1			;and correct to number of 64-word records
	sta ilngth		;and save in program length indicator
	sta mksxg		;Make positive for TEACH
	sto *+2,3		;and set in parameter list
kreadb:spb dska,2		;Go read
	z12 --		;Read, constructed length
	z00 --		;Constructed memory address
	z20 smbx2		;Points to disk address
	bru erxtmm		;Error return

kreta:ldx kret,2		;Return point
	bru 1,2		;and get out


,     lwwrit writes a source program from the
,     lower (2K) area of memory onto the teletype
,     standard area


lwwrit:stx kret,2		;Save return location
	lda ilngth		;Get program length
	sto *+2,3
	spb dska,2		;Write
	z37 --		;write, constructed length
	dec k2area		;from lower area
	z20 smbx2		;address in mailbox 2
	bru erxtmm		;Error return
	bru kreta		;Get back

	stl			;SYREAD
!!Page 65
	ttl			;System intput/output routines


,     Each time-sharing compatible system or
,     system overlay must carry certain information
,     for the executive at its head.  The format
,     is rigid and must be exactly followed by
,     overlays, replacements, and systems.



,     Word No.             Function

,     0] System exit location - exit branch
,        supplied by executive when systems are
,        brought into memory.
,     1] Entry point - executive transfers here to
,        begin running a problem.
,     2] Transfer to cleanup routine for systems
,        that use disk - this is so that when a
,        user types *STOP* his disk space is
,        returned to the available space list.
,     3] Spare
,     4] Alfameric system name - first 3 letters.
,     5] Number of replacement of overlay - 0 for
,        systems.  In the case of an *OVERLAY*,
,        bit 1 is set on if the overlay
,        destroys the system or replacement that
,        called it.
,     6] Move constant - 0 if no move - tells
,        executive to move to here...
,     7] this many words (in two's complement form)
,     8] from here.





,     syread checks to see if the called system
,     is in memory.  If not, it searches for its
,     address in a table, then reads in the system
,     into core memory address 20000.


syread:stx kret,2		;Save entry point
	dld movid		;Put replacement number in Q
	lda smbx1		;System wanted
	dcb in		;Check to see if in memory
	bru *+2		;No
	bru syovk		;Check if correct overlay in memory
	ldx zero,2		;Initialize counter/pointer
!!Page 66
sysrch:cab sytab,2	;Seatch system table
	bru *+2
	bru syfind		;Found
	inx 1,2		;Count
	bxl last,2		;and check for end of table
	bru sysrch		;No, try again
	bru rsnot		;System not in table
syfind:lda z2		;Save table pointer (for overlay calls)
	lda inpnt
	add morep		;Step by replacement number
	sta z2		;and set to get system disk address
	lda sytab+1,2	;Address
	sta *+4,3		;Set in parameter list
	spb dska,2		;and go read
	z12 96		;Read, 96 records
	dec system		;into 20000
	z00 --		;address, constructed
	bru erxtmm		;Error return
	ldx syloc,1		;Read-in location
	spb symov,2		;Move constants down and set up identifiers
,     If system was read, overlays must be read in
	lda movid
	bze
	bru *+2		;No overlay
	bry syova		;Get overlay
	sta inov		;Set flag to zero
	bru kreta		;and get out

syovk:lda movid		;Get overlay number requested
	bze			;Check for no overlay
	sta inov		;If so, then reset overlay indicator
	cab inov		;Check for correct overlay
	bru syova		;No, go read in overlay
	bru kreta		;Yes, get out
	bru syova		;Else go get overlay


rxnot:lda usn		;System cannot be found or read in
	bru erex

	stl			;syov
	ejt
!!Page 67

,     Overlay read-in routine.  Entered from syread
,     or from ovcall, reads in overlay to
,     specified location, then returns according to
,     which routine called it, back to program if
,     called from ovcall - else back to original
,     caller- kstart or kcntnu.



syov:	spb irase,2		;Erase entry that called
	spb dskb,2		;Request disk from Datanet-30
	ldz			;Overlay is special, so special measures
	sta dkflg2		;must be taken - reset disk flag 2
	lda movint		;and check interrupt flag
	bze			;If zero, then interrupted
	bru 2,1		;So ignore the rest of this
	lda movid		;Overlay identifying number


syova:add inpnt		;inpnt points to master system address
	sta z2		;Location of overlay address
	lda sytab+1,2	;Get it
	sta syovb+3,3	;set address in parameter list
	lda molen		;Length of overlay
	sto syovb+1,3	;set in parameter list
	lda momem		;Memory address of where it goes
	sta syovb+2,3	;set in parameter list

syovb:spb dska,2		;Get overlay
	z12 --		;read, constructed length
	z00 --		;memory address
	z00 --		;disk address - constructed
	bru erxtmm		;No go
	ldx momem,1		;Get read-in address
	lda morep		;and set up replacement number of current
	sto 5,1		;System
	lda movid		;Set overlay number in indicator
	sta inov
	spb symov,2		;and go move constants and set up identifiers
	lda movint		;Check if dump 6 occurred while reading
	bze			;in overlay
	bru kreta		;Yes, go back to caller
	spb relin,2		;Let's not relinquish twice
	bru sret		;No, go back to system



symov:lda sexit1		;Set exit location
	sta 0,1		;and set in first word of system/overlay
	dld 4,1		;Check if correct system...
!!Page 68
	cab smbx1		;brought in
	bru rsnot		;No
	bru *+2
	bru rsnot		;No
	dst in		;Yes, set in indicator which gives system and
	lda 8,1		;overlay #.  Construct system constant move
	add smove1
	sta symov1,3
	dld 6,1		;Where and how may words
	cab mendt		;Check for no move
	bru 1,2		;If no move, exit
	bru *+1		;Yes
symov1:mov --		;Move constants where requested
	bru 1,2		;and exit

	stl			;Disk request
	ttl			;Disk read/write routines
!!Page 69

,     DSKR is entered on xreg 2 by non-D-30 tasks.
,     It checks both dkflg1 and dkflg2 for non-zero.
,     It also steps dreqf on entry, an decrements
,     it on exit.  This is so that the relinquish
,     routine will not needlessly give back the
,     disk to the Datanet-30.  When both dkflg1 and
,     dkflg2 have gone zero, it asks the Datanet-30
,     for the disk.


dskb:	lda z2		;Get return point
	maq			;and save in entry
	lda .dskc.		;Set up entry to check
	spb insert,2	;for other disk usage.
	sta z1		;Save where inserted for returns

dskc:	lda dkflg1		;Check disk flags.  If either non-zero, then
	bze			;some task is waiting for or using the disk
	bru dskc1
	lda dstakf		;Wait for special requests to terminate
	bze			;before granting access to Datanet-30-called
	bru 2,1		;tasks.  So wait on D-30 if non special.
dskc1:lda dkflg2		;Time-sharing task using the disk or no
	bnz			;D-30 task waiting.
	bru 2,1		;Some other routine using disk, so punt
	lda pmbx0		;Wait for message switching to go normal
	bpl
	bru 2,1		;If plus, the message waiting to be answered
	sta dkflg2		;All OK, so set disk flag 2 non-zero
	lac			;Set timing interval to 1 second plus
	add seven
	sta hdskd
	lda .dskd.		;Get entry to wait for D-30 answer
	sta 0,1		!!I believe this entry overwrites the call to dskc
	lda hdreq		;Ask for disk
	sta pmbx0

dskd:	bcs brr,0		;If the disk is ready
	bru dskg		;then get out
	lda pmbx0		;Else check if D-30
	bmi
	bru 2,1		;has answered, and if so, wait on
	lac			;Else check timing interval
	cab hdskd
	bru 2,1		;Still OK
	bru 2,1		;Ditto
	add cr		;Reset time check
	sta hdskd
dsko:	spb messg,2		;and type message to clear disk
	dec dc		;Disk controller
!!Page 70
	bru 2,1		;and exit

dskg:	lda 1,1		;Disk ready, so get return
	sta z2
	bru irase		;Erase entry and return to caller



,     DSKA is entered by D-30-called routines.
,     It sets dkflg1 to +1, then waits for dkflg2
,     to be reset.  When other tasks have finished
,     with the disk, it sets dkflg1 negative to
,     indicate the disk is being used.
,     Entry is on xreg 2 with the disk parameters
,     immediately following th calling sequence -
,     see dskop for an explanation of the parameter
,     setup.



dska:	lda z2		;Get return point
	sta dkflg1		;and set disk flag 1 positive to indicate wait
	maq			;Save return
	lda .dskx.		;Set entry for continuation
	dst iprior,3	;and set in priority entry
	ldx kfudge,1	;and get where entry is by fudge factor

dskx:	lda dskflg2		;Wait for disk flag 2 to go zero
	bnz
	bru 2,1		;No, exit
	lda dstakf		;Check special requests stack flag
	bnz			;and punt it they are not done
	bru 2,1		;dskb will continue to give them the disk
	ldx dkflg1,2	;Now get flag - is also calling point here
	lmo			;Set disk 1 negative to indicate
	sta dkflg1		;actual use
	lda .disk.		;Set entry for disk routine
	sta 0,1
	bru dskh		;and go to special entry point

	stl			;DSKOP
	ejt
!!Page 71



,     DSKOP may be entered directly or through dskh
,     The calling sequence follows the spb on xreg2
,     and is given below...

,     A      spb  x, 2
,     A+1    1) No. of 64-word records in bits 5-19
,            2) Type of instruction in bits 2-4...
,               12  indicates a read.
,               37  indicates a write.
,     A+2    Starting memory address - mod 64
,     A+3    If negative, indirect pointer to disk
,            address.  If positive, address itself.
,     A+4    Error return - nature of error in high
,            order bits.
,               Bit 4 - illegal address
,               Bit 3 - not used as yet.
,     A+5    Normal return.  Any non-terminal error
,            conditions are reflected in bits 0-4
,            as follows...
,               Bit 2 - unused as yet
,               Bit 1 - recovered parity error
,               Bit 0 - unrecovered parity error.

,     Dskop uses 96-record-read and will give
,     illegal address indication if more than
,     92 records are asked for.


dksop:stx .disk.+1,2	;Get return point
	dld .disk.		;and get entry
	spb insert,2
	sta z1		;save for returns
	ldx .disk.+1,2	;Get entry point again

dskh:	ldz
	sta dcnt		;Reset length counter
	sta drcnt		;Error count
	lda 1,2
	sto dnct		;Length of operation
	ext mask11		;Get high order bits for type
	add dinst		;Construct instruction
	sta doper+1,3
	lda 2,2		;Memory address
	sta iadrs+1
	lda 3,2		;Pick up disk address
	sta z2
	bmi			;Indirect if minus
	lda 0,2
!!Page 72
	sta iadrs
	ext mask1		;Check if legal
	sub o300		;If over 300 with other bits gone then
	bpl			;illegal
	bru dker		;yes
	lda iadrs		;Get address back
	sta dseek+2,3	;put away in case legal
	ado			;Set bit 19 for relinquish
	sta relad,3
	lac
	add o40		;Set timing interval
	sta dival

disk:	spb dskwt,2		;Wait for disk
	lda .dsec.
	sta 0,1
dseek:sel 0			;Seek command
	prf ,0
	oct 0			;Disk address - constructed
	lda dcnt		;Compute 96-record bit setting
	sta z0		;See if over 96 records
	bxh 97,0
	bru dker		;Should not happen
	srd 4
	xaq			;Remainder mod 16 in A
	sra 15		;Position remainder
	bze
	dad d15		;15, -1
	ory doper+1,3	;Put away
	lda iadrs+1		;Get memory address
	ext mask10		;3700000  make sure not to wipe high order bit
	sta doper+2,3
	ldz			;Set bits 2-4
	scd 4
	ory doper+2,3
doper:sel 0			;Read/write
	z00 --		;Constructed (instruction, length?)
	z00 --		;Constructed (memory address?)
	bru 2,1

dsec:	spb dskwt,2		;Wait
	bcs ber,0		;Check for errors
	bru dcorr		;Try to correct
dexit:lda 1,1		;Get return point
	add four		;and step for correct return
	sta z2
	bru irase		;and exit back to caller



dskwt:bcs brr,0		;Is disk ready...
!!Page 73
	bru 1,2		;yes, exit back to caller
	lac			;Check interval
	cab dival
	bru 2,1		;Still OK, go back to task list
	bru 2,1		;ditto
	add cr		;Set interval large enough to give
	sta dival		;message time to get out
	oct 2516036		;Check for lockout bit set
	bru dsko		;No, so type message to clear
	spb messg,2		;Yes, type reminder on typewriter
	dec datnet
	lda hdreq		;Ask D-30 for disk - shouldn;t have to
	spb spmess,2
	bru 2,1		;and return


,     Error correction routine - will try
,     five times and then consider the frame as
,     correctly transferred.  Any error is noted
,     by setting bit 1 on in the return address.
,     If an error persisted the record was rewritten
,     on the disk and bit 0 is set.

dcorr:ldx drcnt,0		;Error counter
	inx 1,0
	bxh 6,0		;Tried five times
	bru dnorec		;No recovery
	stx drcnt,0
	lda bit1		;Set bit 1 on in return address
	ory 1,1		;to signify parity error of some sort
	bru dseek


dnorec:lda sign		;Set bit 0 on in return address
	ory 1,1
	bpe			;Clear out any parity indicator
	nop
	ldx iadrs+1,2	;Get read-in address
	bru *+2
dnore1:inx 2,2
	dld 0,2		;and find where parity error was
	dst 0,2
	bxl 2,2		;Do not go too far
	bru *			;Parity on disk yet none in memory
	bpc
	bru dnore1		;Try again
	lda z2		;Get address of error
	ext mask8		;77  make a multiple of 64 words
	sta dcorra,3	;Put address in write command
	sub iadrs+1
	sra 5			;Compute new disk address
!!Page 74
	add dseek+2,3
	sta dcorrp,3
	sel 0
	prf ,0		;Position to write back bad record
dcorrp:oct 0		;Disk address
	bcs brn,0		;Wait till ready
	bru *-1
	sel 0
	wrf 1,0		;Write record back on
dcorra: &0			;Address in memory
	lda dcorrp,3	;Get exact disk address
	spb adrser+1,2	;and output it
	dec dp
	lda .disk.		;Set up task for disk
	sta 0,1
	bru 2,1		;and get out


dker:	spb adrser,2	;Illegal address message
	decl ilg
	lda 1,1		;Get return address
	add bit4		;Set bit 4 on
	add three		;and return to error return
	bru dexit+2		;Get out


adrser:lda iadrs		;Get address
	stx rawt,2		;Save entry point
	spb convrt,2	;and convert address
	sta adr1		;and set in message
	laq
	sta adr1+1
	spb messg,2		;Type message
	dec adrs
	ldx rawt,2		;Get entry again
	bru messg		;and type kind of address error

	stl			;Relinquish
	ejt
!!Page 75

,     RELIN relinquishes the disk to the Datanet-30.
,     If no task has used the disk, then the relin-
,     quish is vacuous; if any task is waiting for
,     the disk, then the relinquish is punted.


relin:set prq		;Request interrupt after completion
	dld zero		;Check out status of flags
	cab dstakf		;See if more tasks waiting
	bru relex		;yes
	bru *+1
	cab dkflg1		;Against disk flag 1
	bru relex		;waiting
	bru *+2		;Not used by D-30-called tasks
	bru relq		;Definitely used
	cab dkflg2		;Against regular task flag
	bru relq		;Used
	bru relmes		;no, so send message only

relq:	dst dkflg1		;Reset flags
	bcs brn,0
	bru *-1		;It shouldn't happen, but just in case
	sel 0			;and relinquish
	prf ,0		;Disk had better be ready
relad:oct 403		;Set up by dskop - 403 if for after boot.
	bcs brn,0		;Wait here
	bru *-1		;for disk
	sel 0			;and read after write next sector 0 records
	oct 1213040		;with power dropped and API set
	oct 0
relmes:lda two		;Tell D-30 it has disk
	sta pmbx0
	bru 1,2		;and return

relex:sta dkflg2		;Reset disk flag 2
	bru 1,2		;and get out

	stl			;Peripheral overlay read
	ejt
!!Pge 76

,     The peripheral overlay calling routine is
,     entered from the table of typewriter-entered
,     tasks, to perget.  It is also entered to
,     pgetb, byt other peripheral tasks, to chain
,     several in sequence.  When entry is through
,     perget, the routine checks to see if any
,     other peripheral tasks are currently in
,     memory...if so, it punts and types 'busy',
,     else it calls in the overlay from the disk
,     address given in the word after the calling
,     location.
,     It also saves the overlay called, so that if
,     the same peripheral task is called twice in
,     a row, it does not read it in the second time.



perget:lda bzyf		;Check busy flag - if on
	bnz			;then not zero,
	bru ibusy		;so punt.

pgetb:lda z2		;Get caller
	sta bzyf		;and set flag to busy status
	cab perin		;and check if already in memory...
	bru *+2		;No
	bru execov		;Yes, go execute
	sta perin		;Else set in indicator
	lda 2,2		;and get disk address
	sta pgetx,3		;and set in parameter list
	spb dskb,2		;Get disk from Datanet-30
	spb dskop,2		;and go read in overlay
	z12 8			;Read eight records
	dec execov		;Memory location
pgetx:z00 --		;Disk address
	dec -1		;Should never ever return here.....
	spb relin,2		;Relinquish disk to Datanet-30
	bru execov		;and go execute

	stl			;System-called routines
	ejt
!!Page 77

,     DRAMB is entered on xreg 2 by background
,     systems that require disk usage.
,     DRAMA is entered on xreg 1 by time-sharing
,     systems that request the disk.
,     The calling sequence is...

,     A      spb   dramb,2
,     A+1    Indirect pointer to a parameter list -
,            see later for an explanation.
,     A+2    Return point.  The return is executed
,            immediately, and the completion of the
,            operation is signalled by setting a
,            flag in the parameter list.

,     The parameter list is a four-word table, set
,     up as follows...

,	P      1) No of 64-word records in bits 5-19,
,	       2) Type of operation in bits 2-4...
,	          12 - indicates a read
,               37 - indicates a wite
,	P+1    Starting memory address - mod 64
,	P+2    Disk address for read or write,
,	       sign bit set if scratch area is to be
,	       supplied to a system by the executive.
,	       In this case, each system has 48
,	       64-word records available, and the low
,	       order end of the parameter word must
,	       specify what particular record is to
,	       be accessed.
,	       Note...the particular address used
,	       will be stored in P+2 by the executive
,	       but most users will want to ignore
,	       this.
,	P+3    Flag to indicate completion of
,	       operation.  Upon completion of
,	       the operation, it will be set odd if
,	       the operation was successful, even
,	       otherwise.  In either case, certain
,	       conditions will be indicated in the
,            high order bits...
,	          Bit 4 - illegal address (error)
,	          Bit 3 - too many requests stacked
,	                  up (error)
,	          Bit 2 - not used at present
,	          Bit 1 - parity (recovered, no error)
,	          Bit 0 - parity (unrecovered, but
,	                  transfer complete, so no
,	                  error indication given)

!!Page 78  9/30/02
,	A maximum of four
,	simultaneous calls are allowed.  There
,	must be as many parameter lists as there may
,	be simultaneous calls, and the user should
,	not modify the parameter list for a given
,	call until that disk operation has been
,	completed.



drama:ldx mkp,2		;Get entry point
	bru *+2


dramb:inx 1,2		;Step for return in any event
	lda 0,2		;Points to *P*
	sta .drmc.+1	;save
	ldx .drmc+1,1	;Set in register
	ldx dstakf,0	;Get stackup flag
	bxh 4,0		;If four stacked up, crump
	bru dsful
	inx 1,0		;Else step by one
	stx dstakf,0	;and save
	ldz			;and zero out return word
	sta 3,1		;*P+3*
	dld .drmc.		;Get list entry
	bru insert		;and go insert in task list



drmc:	ldx dstakp,2	;Points to dstak-4
	inx 3,2		;Step to next entry
	lda 3,2		;and get second word - check if entry free
	bnz			;non-zero in use
	bru *-3		;so try again - we know there is at least 1
	lda 1,1		;Get pointer to *P*
	sta 3,2		;and set in stack
	bru irase		;then erase current entry

,     The following entries go in groups of
,	four.  They are all identical

dstak:spb dskb,2		;Now wait for disk
	spb drms,2		;then use
	z00 --		;Pointer to *P* goes here

	spb dskb,2		;Group 2
	spb drms,2
	z00 --

	spb dskb,2		;Group 3
!!Page 79
	spb drms,2
	z00 --

	spb dskb,2		;Group 4 - last entry
	spb drms,2
	z00 --



drms:	stx temp,1		;Save place in task list
	lda 1,2		;Points to *P*
	sta z1		;set for indirect #1
	add stwo		;Points to *P+2*
	sta drmd+3,3	;set in parameter list
	lda 0,1		;Get instruction type and length
	sta drmd+1,3	;and set in parameter list
	lda 1,1		;Get memory address
	sta drmd+2,3	;set in parameter list
	ldz			;Reset waiting list
	sta 1,2
	lda 2,1		;Get disk address
	bpl			;Check if real address
	bru drmd		;Yes, skip all this
	ext mask4		;Get rid of all high order bits and start to
	lqa			;computer scratch address
	add drmd+1,3	;Add record count to starting scratch address
	ext mask4		;Wipe out high order bits
	sta z0
	bxh 49,0		;See if too many [records]
	bru dnovl		;Yes, error return
	xaq			;Get number [of records] back
	sla 1			;Position correctly
	add mkdisk		;add teletype address
	add o440		;step 400 to get scratch area
	sta 2,1		;and put away

drmd:	spb dskop,2		;Read/write on disk
	z00 --		;Type and length
	z00 --		;Starting memory address
	z00 --		;Pointer to disk address in parameter list
	nop			;Ignore errors - sort of
	stx temp,1		;and save place in list
drme:	lda drmd+3,3	;Points to *P+2*
	sta z1
	lda z2		;Get spb to dskop - has error info in high
	ext mask11		;order bits.  Isolate these
	bze			;check for no errors
	ldo			;If none, set completion indicator odd
	sta 1,1		;and set in word four of parameter list
	lda dstakf		;Release stackup flag one notch
	sbo
!!Page 80
	sta dstakf
	ldx temp,2		;Get place in task list
	bru relin		;and relinquish disk



dnovl:ldx bit4,2		;Set illegal address bit on
	bru drme		;and return


dsful:lda bit3		;Special bits for stacker full error
	sta 3,1		;and set in *P+3*
	bru 1,2		;Return to caller

	stl
	ttl			;System exits
!!Page 81
,     All exits are entered by an spb 20000 (octal)
,	on index register 1, with an appropriate
,	constant in the A-register.
,	The constants and their corresponding
,	exits are as follows...
,	0 - Terminal exit.
,	1 - Intermediate output exit.
,	2 - Input call exit.
,	3 - Overlay call temporary exit.
,	4 - Overlay delete call
,	5 - Disk operations call
!!JSM edited for clarity and correctness 9/30/02
,	6 - Special data transfer to the D-30,
,	    using the special mailbox.
,	7 - Special data transfer to the D-30,
,	    using the regular mailbox.
,	    The calling sequence for these is
,	        A    spb 20000 (octal)
,	        A+1  data word 1
,	        A+2  data word 2
,	        A+3  return
,	    Data words 1 and 2 will be sent to the D-30
,	    Data word 1 has special transfer code...
,	        12 - send ending disk address
,      8 - Change dump length.  Q has the ending dump
,	     address, which must be rounded to the
,	     the next higher multiple of 64.
!!End JSM edits

,	When the sytems request a terminal exit,
,	intermediate output, or real-time input, the
,	executive will request a dump from the D-30
,	after saving the type of exit.


sysex:set pbk		;No interrupts while setting up exits
	inx 1,1		;Save return location incremented by one
	stx mkp,1
!!The comparison below needs to have a symbolically defined
!!upper bound based on the length of the branch table
	cab ten		;Dec 10 to see if legal call
	bru sysx1		;Yes [length < 10]
	bru sret		;No, so return
	bru sret
sysx1:sto sexit2		;Set up for branch
	ldx sexit2,1
	bru sysx2,1		;and branch to start of list
sysx2:bru term		;0 - Terminal exit
	bru otex		;1 - Intermediate output exit
	bru inex		;2 - Input call exit
	bru ovcall		;3 - Overlay call
	bru ovdel		;4 - Overlay delete
	bru drama		;5 - Disk operation
	bru sptra		;6 - Special transfer
	bru sret		;7 - Not used yet so just return
	bru sydlc		;8 - Change dump length


!!Page 82
sret:	ldx mkp,1		;Return
	set pst
	bru 0,1


!! The code below has two bugs:
!! (1) the message from the system can usurp
!!     executive functions with codes < 10
!! (2) because the message is stored before
!!     the parameter, there is a potential 
!!     race condition, by which the D-30
!!     can pick up the message before the
!!     parameter has been stored.
sptra:ldx mkp,1		;Get entrance location
	lda pmbx0		;Wait for special mailbox
	bpl			;to go minus
	bru *-2		;better not take too long
	lda 0,1		;Data word 1
	cab ten		;See if legal
	bru sptrx		;No
	bru *+1		;Yes
	sta pmbx0		
	lda 1,1		;Data word 2
	sta pmbx0+1		;in special mailbox+1
	lda pmbx0		;Wait for acknowledgment
	bpl
	bru *-2
sptrx:inx 2,1		;Set for return
	bru sret+1		;and enter return


waitex:lda mbx0		;Do not wipe out D-30 message
	bpl			;If none, go on
	lda kmesd		;Request dump
	sta mbx0		;Answer Datanet-30
	set pst		;Hang up waiting for interrupts so as not
	bru *-1		;  to destroy any index registers


term:	lda kmest		;Terminal exit
	sta mdc		;put in dump code
	bru waitex		;and exit


otex:	lda kmeso		;Intermediate output message
	sta mdc		;put in dump code
	bru waitex		;and exit


inex:	lda kmesi		;Real-time input call
	sta mdc		;put in dump code
	bru waitex		;and exit

,	Change dump length.  Q has ending memory address
sydlc:xaq			;Get address in A
	sub k6loc		;subtract starting address
	sra 6			;divide by 64 to get record count
	cab o140		;See if legal length [<= 96]
	bru *+3		;yes
	bru *+2
	bru sret		;No, so just return
	sta mdl		;Store in length
!!Page 83
	bru sret		;and return

	stl			;Overlay call
	ejt
!!Page 84


,	The overlay call is a special system feature.
,	It is treated as a special system exit.
,	An overlay call may be used to supplement or
,	replace part or all of a system.  If a system
,	is replaced by an overlay (this is indicated
,	in the calling sequence), only the replacing
,	overlay will be called back in after swaps.
,	Furthermore, system replacements may have
,	their own overlays.
,	If a called-for overlay is already in memory
,	the information will be placed in the save
,	area, and the overlay will not be read in.

,	Two conventions must be rididly adhered to:
,	1) All systems, overlays, and replacements
,	   must have the same heading information
,	   in the same format.  (See SYREAD)
,	2) The numbering system for overlays,
,	   replacements, and systems, must be unique.
,	   That is, if overlays, replacements, and
,	   systems are considered as integral units
,	   of core memory, then each of
,	   these units must have a unique identiying
,	   number in the word after the system name.


,	The calling sequence is as follows...

,	A      spb 8192, 1 with a 3 in the A-register
,	A+1    Replacement # of current unit in
,	       memory, unless a new replacement is
,	       being called, in which case this
,	       should have the number of the new
,	       replacement.  This is the only case
,	       in which overlay and replacement
,	       numbers may match up in the calling
,	       sequence - see next item.
,	A+2    Number of overlay being called.  If the
,	       overlay destroys [??] the system currently
,	       in memory, then this word should
,	       have the sign bit on.  This is so that
,	       if a dump occurs while the overlay is
,	       being brought in, the executive will
,	       not needlessly read in the system
,	       again for a new problem.
,	A+3    Length of overlay.  It will be truncated.
,	       So if length is not an exact multiple
,	       of 64 words, it should be extended at
,	       least as far as the next 64-word multiple
!!Page 85
,	A+4    Memory address where the overlay
,	       is desired - must be a multiple of
,	       64 words.
,	A+5    Return address.


ovcall:ldx mkp,1		;Entry location, stepped by one
	lda 0,1		;[A+1] Replacement number
	sta morep		;and save
	lda 1,1		;[A+2] Overlay number
	bmi			;Check if destroys system
	sta in		;yes
	sto movid		;and set in save location
	lda 2,1		;[A+3] Get length mod 64
	sra 6
	sta molen		;and save in length indicator
	lda 3,1		;[A+4] Get memory address and extract
	ext edmsk2		;low-order end
	sta momem		;memory location
	inx 4,1		;[A+5] Step return address
	stx mkp,1		;and save
	lda movid		;See if overlay called is already in memory
	sub inov
	bze
	bru sret		;yes
	stx movint,1	;Set flag for interrupts
	ldx 8K,1		;Do not destroy system's index registers
	lda .syov.		;Set entry to read in overlay
	sta iprior,1	;Special treatment
	sta inov		;Destroy overlay indicator
	set prq		;Priority request
	set pst		;and wait for process to finish
	bru *-1



,	Overlay delete call deletes unneeded overlays.
,	Return is to the first word after the spb.



ovdel:ldz			;Reset indicator to show no overlay
	sta movid
	bru sret		;and get back

	stl			;MESSG - type routine
	ttl			;Odds and ends
!!Page 86
messg:ldx stack,0		;Check stack
	bxh 4,0
	bru 2,2		;If three stacked up, crump
	inx 1,0		;Bump up stack
	stx stack,0		;and save
	lda 1,2		;Get pointer for message
	maq
	lda .pms1.		;Initial entry
	inx 1,2		;Step for return
	ton			;Set for output
	bru insert

pms1:	ldx typf,2		;Check output flag
	bxh 1,2		;If non-zero, then on
	bru 2,1		;so try again later.
	lda 1,1		;Address of message
	sta pcnt+1		;and set in save location
	dld .pty.		;Get entry
	dst 0,1		;and replace old
	stx typf,1		;Set flag on and save pointer
pmore:inx 12,2		;Set for first character
	stx pcnt,2		;and save
	ldx pcnt+1,2	;Word pointer
	lda 0,2		;Get next word
	sta ptemp		;and save it
	inx 1,2		;Step pointer
	stx pcnt+1,2	;and save it
	bru 0,1		;Then exit

pty:	ldx typf,1		;Get branch word
	ldx pcnt,2		;and get word pointer
	lda ptemp		;Get word
	sra 0,2		;and shift for character [12, 6, 0]
	ext mask7		;Get rid of high-order bits
	cab peom		;and check for end-of-message
	bru *+2		;if not, OK
	bru pdend		;else crump
	san 6			;Put character into N-register
	typ			;and output it
	bxl 1,2		;Check for new word needed
	bru pmore		;if so, get it
	inx -6,2		;Else set for next character
	stx pcnt,2		;and save
	bru 0,1		;Exit

pdend:lda stack		;Decrement stack counter
	sbo
	sta stack
	bze			;Do not reset unless stack at zero
	kon
	stx z2,1		;Set for 'irase' exit
!!Page 87
	ldz			;and reset flag
	sta typf
	bru irase		;and exit

	stl			;IREC, SPMESS, EFFY, CONVRT, TIME
	ejt
!!Page 88

,	Debugging tape dump.  Writes lower memory
,	from 0 to 'sclock'+3 - see how long tape
,	takes to come ready by saving counts in dump


irec:	lac
	add three		;Wait two counts of clock
	sta temp
irecs:lac			;Now check
	sub temp
	bpl			;If time up, exit
	bru 1,2
	bcs rtn,1		;Else check tape
	bru irecx
	sel 1			;and write lots of stuff
	wtb 0,0
	 %sclock+3
	bru 1,2		;and get out


,	This routine waists for the Datanet-30 to
,	answer all previous messages and then
,	exits.


spmess:bss 0
	lqa			;Save message in Q
	lda pmbx0		;and wait for any other messages to be
	bpl			;acknowledged
	bru *-2		;Hope we don't hang too long
	laq			;Get message
	sta pmbx0		;and set in special mailbox
spmesx:lda pmbx0		;and wait for this message to be answered
	bmi			;If negative, we are OK
	bru 1,2		;so get back	
	bru spmesx		;else wait for answer


,	EFFY is set up by the wait loop every 10
,	minutes.  It waits for all peripheral
,	activity to cease, then calls in an overlay
,	which dumpes the efficiency summary info
,	onto the disk.


effy:	lda bzyf		;Wait for peripheral tasks to be completed
	add stack		;and wait for all typing to stop
	bnz
	bru 2,1
	spb irase,2		;Erase entry
!!Page 89
	ldx zero,2		;and get summary overlay
	inx summry,2
	bru pgetr



,	Conversion routine


convrt:ext mask6		;Mask out sign bits
	srd 15		;Put most in Q
	sla 3			;Begin spacing with zeros
	sld 3
	sla 3
	sld 3
	sta mstemp
	ldz
	sld 3
	sla 3
	sld 3
	sla 3
	sld 3
	lqa
	lda mstemp
	bru 1,2		;Return

,	TIME - entered on xreg 2
,	uses temp and mstemp

time:	lac
	add h2		;Add 1 minute
	sta itim		;Save incremented time
	sub o400		;Make it reasonable
	maq
	dvd h1		;Get hours
	dst mstemp
	maq			;[Move hours to Q]
	dvd ten		;Convert to decimal
	bze			;Delete leading zeros
	lda o60		;[If zero, get a blank]
	sla 6			;[Move char left one char position]
	sta temp
	laq			;[Or in the second character]
	ory temp		;[temp now has the hours]
	dld mstemp		;[Get fractional hours in Q]
	lda zero
	dvd h2		;Get minutes
	maq			;[Move minutes to Q]
	dvd ten
	sla 6			;[Tens of minutes in mstemp]
	dst mstemp		;[minutes < 10 in mstemp+1]
!!Page 90
	add mstemp+1	;[Complete minutes in A]
	add colon
	maq			;[Leading colon, minutes in Q]
	lda temp		;[Hours in A]
	add blzz		;Leading blank
	bru 1,2		;Return


	loc 37000		;Overlays go here
execov:bss 1		;Normal peripheral entry point
	bss 1			;System entry to peripherals
bres:	bss 1			;Restart entry to peripherals
kbrun:bss 1			;Permission to run entry for batch processing
	bss 508		;Save some space
	tcd load
	stl			;Lister
	ttl			;Peripheral overlays
!!Page 91


,	Time-sharing lister.  Will list a deck of
,	decimal cards, converting parentheses and
,	other characters for printer compatibility.
,	This lister is buffered and requires that the
,	first card be in the hopper before starting.
,	The deck must be followed by two blank cards.

,	Error messages are printed on the console
,	typewriter.
,	At any time, depressing switch zero will
,	cause all activity to halt.
,	For the 235, as follows...
,	C/P followed by a carriage return will
,	    produce a single-spaced, untranslated
,	    listing.  All other options must follow
,	    the following code...
,	S   Single spacing
,	D   Double spacing
,	N   Not translated
,	T   Translated for printer compatibility
,	C/P must be followed by two letters if an
,	alternative option is selected,
,	as in  C/PST  followed by a CR.
,	After an error, depressing switch 2 will
,	cause the listing to take up where it
,	left off.


	org pernum
	dec 0
	dec c/p
	org execov
	dld .lst.,3		;Get entry
	spb insert,2	;and insert in list
	sta ovtsk
	bcs bpr,6
	bru lst1
	spb messg,2
	dec pnr		;Printer not ready
	bru lndra
lst1:	bcr
	bru L235
	spb messg,2		;Card reader not ready
	dec crn
	bru lndra
L235:	ldz
	sta lf
	lmo
	sta llnt1
!!Page 92
	sta llsd1
	spb lchar,1		;Get next character from ty+1
	cab cr		;Check if carriage return
	bru *+2
	bru lsn		;Go check all correct
	bxh 3,2		;If not CR, and LF gte 3, then error
	bru lerr1
	ldx 8K,2		;Initialize looping variable
lst2:	cab ltab,2
	bru *+2
	bru ltab+1,2	;Go to indicated task
	inx 2,2		;Increment
	bxl 8,2		;Test for end
	bru lst2
lerr1:bru ild		;Illegal task

lsn:	lda lf		;Check indicator
	cab two
	bru lsn1		;Single spaced and untranslated
	bru lerr1		;lf equals 2, second char a CR, error
	bru lista		;done
	oct 624537		;S N CR
lsn1:	lda *-1,3		;Easiest way to get N and S
	sta ty+1
	bru L235

lchar:ldx lf,2		;Character picking up routine - easily
	bxh 1,2		;modified to other uses...
	bru lchar1		;If greater than zero, then not first time
	lda ty+1		;Get second word
	sta lch3		;Last character
	sra 6
	sta lch2		;Middle character
	sra 6			;First character
lchar2:ext mask7		;Get rid of higher-order end
	inx 1,2		;and increment counter
	stx lf,2		;and save
	bru 1,1		;Get out
lchar1:lda lch2-1		;Get character
	bru lchar2		;and return


ltab:	alf 00N		;No translation
	bru ln
	alf 00S		;Single spacing
	bru ls
	alf 00D		;Double spacing
	bru ld
	alf 00T		;Translated
	bru lt

!!Page 93
ln:	lda ln1,3
	sta lnt,3		;Set up instruction
	bru llnt

lt:	lda lt1,3
	sta lnt,3		;Store
	bru llnt

llnt:	lda llnt1		;Get counter
	ado			;increment
	bnz
	bru lerr1		;Some idiot did it again
	sta llnt1
	bru lchar


ls:	lda lss,3		;Get instructions
!!***************************************************
!!JSM: ERROR: the instruction below was originally
!!    sta lpr+1
!!unindexed.  It seems incorrect as the effect would
!!be to place a printer instruction to slew one line
!!--which is also an 'add 0'--into a location high
!!in the 6K area, almost at its end.  This instruction
!!would not cause a halt, and would probably affect
!!only some user's running program, and then only if
!!the program was large.  Furthermore, the error
!!would only occur if C/PS were specified; as S is
!!the default option, it is unlikely that many people
!!at Dartmouth would ever have done so.  This error
!!is also present in my 235 executive listing, from
!!March 1965, so it's been around a long time.
!!I've corrected it to include index register 3,
!!which (almost) always had the 8K bit set. The
!!corrected instruction is shown below.
!!***************************************************
	sta lpr+1,3		;[JSM: 9/30/02 Corrected, missing index 3]
	lda L56,3		;Number of lines per page
lscnt:sta lpage
	sta lncnt
	lda llsd1		;Make sure no idiot tries both single and
	ado			;double space
	bnz
	bru lerr1
	sta llsd1
	bru lchar		;Go back for some more

ld:	lda lss,3		;Get instruction
	sla 1			;modify for double space
	sta lpr+1,3
	lda L56,3		;and count
	sra 1
	bru lscnt		;and get out



lst:	ldz			;Entry point here
	bcs			;Check switch zero down
	bmi
	bru 2,1		;If so, out
	ldx lpoin,2		;Get exit point
	bru 1,2		;and return



lista:dld lareas,3	;Get buffer areas
	dst lin		;and set in flip-flops
	sta io1+27		;[Trash first buffer's syncword location]
	lac			;and set timing interval
	add six
!!Page 94
	sta lctim
	lda cmessb		;Do not acknowledge if batch on
	bze
	spb messg,2		;Acknowledge receipt
	dec pcr		;[Works because lda = 00]
	rcd io1		;Read in first card
	hcr

lslew:spb lret,2		;Exit and wait
	bcs bpn,6		;Punt if not ready
	bru 2,1
	sel 6			;Slew to top of page
	slt 8
	spb lret,3		;then exit and wait again
	bcs bpn,6		;punt and wait
	bru 2,1
	sel 6			;Slew 3 lines
	slw 3
	lda lpage		;Reset page count
	sta lncnt


list:	spb lret,2		;Exit and wait
	bcs bpn,6
	bru 2,1
	spb lhop,2		;Now check hopper condition
	ldx lin,2		;Area last read into
	lda 27,2		;Check syncowrd
	add lsync,3
	bnz			;If not matched, card read error
	bru lserr
	ldx lin+1,1		;Area to be next read into
	stx lin,1		;Flip-flop them
	stx lin+1,2
	sta 27,1		;Zero out next syncword location
	dld 0,2		;Check for quote card
	dcb lquot,3
	bru *+2		;No
	bru lqchk		;Yes, check rest
lndq:	rcd 0,1		;Read card otherwise
	hcr
lnt:	bru lppnt		;[Default single-space no translation]
lnt1:	dld lmask,3		;Mask for table lookup


lookp:lda 0,2		;Pick up word to be translated
	bmi
	bru lprnt
	z13 z1		;Put mask into xreg 1 [dst odd location]
!!Page 95
	ory z1		;Put character into low-order end
	sra 6			;Make room for new character
	add 0,1		;Pick it up
	z13 z1		;Second character
	ory z1
	sra 6
	add 0,1
	z13 z1		;Third character
	ory z1
	sra 6
	add 0,1
	sta 0,2		;Put away word
	inx 1,2		;Increment address register
	bru lookp		;Return to loop


lprnt:lda lin+1
	sto lpr+1,3		;Construct address
	sel 6
lpr:	wpl 0			;Print line
	sta z1		;Set address in register
	lmo			;Set end-of-line flag
	sta 27,1
	add lncnt		;and decrement page counter
	bze			;If zero, set up to slew
	bru lslew
	sta lncnt
	bru list		;Get back



lret:	stx lpoin,2		;Save exit point
	ldx ovtsk,1		;Get entry point
	bru 1,2		;and get back again


lhop:	bcn			;Check reader
	bru lhop1		;Test hopper not ready
	lac			;Step timer if OK
	add seven
	sta lctim		;and save
	bru 1,2		;exit back
lhop1:ldx lin,2		;Get buffer address
	lda 27,2		;and check syncword for hopper empty
	cab lsync+1,3
	bru *+2
	bru lendr		;End run for list if hopper empty
	lac			;Time check
	cab lctim		;If time has run over, then
	bru 2,1		;get out if time still good
!!Page 96
	bru 2,1
	spb time,2		;or unattended.  Type message and abort run.
	dst lab1,3		;Put away
	spb messg,2		;Type message
	dec lab		;Aborting list, date and time
	bru iredy		;and crump




lserr:spb messg,2		;Type message
	dec cre		;Card read error
	spb lret,2		;Exit and wait on switch 2 down
	ldz			;Resume normal operations
	rcs			;2 is depressed
	ext mask6
	sla 2
	bno
	bru 2,1
	ldx lin,2		;Pick up address of buffer
	rcd 0,2		;Read card
	hcr
	lac			;Pick up and compute delay time
	add six
	sta lctim
	bru list		;and get back and try again


lqchk:lda cmessb		;Check background flag
	bze
	bru lndq		;If not on, crump immediately
lqchk1:ldx ovtsk,1	;Get entry point
	spb irase,2		;and erase it
	ldx zero,2		;Reset 2
	inx batch,2		;and set for batch monitor
	lmo
	sta io1		;Set front card in
	bru pgetb		;Go get batch monitor


lndra:spb lret,2
	lda stack
	bnz
	bru 2,1
	lda cmessb		;Check batch flag
	bnz
	bru lqchk1		;get batch back
lendr:spb time,2		;Pick up time
	dst el1,3		;Put it in type message
	spb messg,2		;Type message
	dec dl		;Done listing, time
!!Page 97  10/1/02
	spb lret,2		;Slew after list
	bcs brn,6
	bru 2,1		;wait for printer
	sel 6
	slt 8			;and slew
	spb irase,2		;and erase entry
	ldz			;Reset some things
	sta bzyf
	sta ovtsk
	sta io1		;So batch does not get fouled up.
	bru 2,1		;Crump right away



.lst.:spb lst,1
	dec -1
lmask:oct 0
	oct 3777700		;Special geek mask for table lookup
lareas:dec io1		;Area 1
	dec io2		;Area 2
lsync:oct 1171701		;Negation of syncword
	oct 3606077		;Hopper-empty constant
louot:oct 777777		;Double 0-7-8 punches
	oct 777777
lss:	add 0			;printer instruction to slew 1 line
L56:	dec 56		;Number of lines per page
ln1:	bru lprnt
lt1:	bru lnt1

pnr:	oct 374751		;Printer not ready.
	alf INT
	alf ER
	alf NOT
	alf & RE
	alf ADY
	oct 333755

crn:	bss 0			;Card reader not ready
	oct 372321
	alf RD
	alf REA
	alf DER
	alf & NO
	alf T R
	alf EAD
	oct 703337
	oct 557777

cre:	oct 372321		;Card read error
	alf RD
!!Page 98
	alf REA
	alf D E
	alf RRO
	alf R B
	alf ACK
	alf SPA
	alf CE
	alf 1 C
	alf ARD
	alf & AN
	alf D T
	alf OGG
	alf LE
	alf 2 W
	alf HEN
	alf & RE
	alf ADY
	oct 333755

	ddc 0
	bss -2
lab:	bss 0			;Aborting list -- time
	oct 372122
	alf ORT
	alf ING
	alf & LI
	alf ST.
	alf & & & 
lab1:	alf & & & 
	alf & & & 
	alf & HO
	alf URS
	oct 373755

	oct 0
	ddc 0
	bss -3
dl:	bss 0			;Done listing - time
	oct 372446
	alf NE
	alf LIS
	alf TIN
	alf G.
el1:	alf & & &
	alf & & & 
	alf & HO
	alf URS
	oct 373755

!!Page 99

	org t			;Temporary storage
lin:	bss 2
lncnt:bss 1
lpage:bss 1
lctim:bss 1
lch2:	bss 1			;Character storage - they must be in
lch3:	bss 1			;sequential order
llnt1:bss 1
llsd1:bss 1
lf:	bss 1			;Character counter
lpoin:bss 1			;Entry pointer


	loc 37700		;Lookup table for lister [*must be at 37700*]
	oct 000000
	oct 010000
	oct 020000
	oct 030000
	oct 040000
	oct 050000
	oct 060000
	oct 070000
	oct 100000
	oct 110000
	oct 120000		;   2-8
	oct 160000		;#  6-8
	oct 140000		;at sign
	oct 150000		;-
	oct 160000		;=
	oct 170000
	oct 200000
	oct 210000
	oct 220000
	oct 230000
	oct 240000
	oct 250000
	oct 260000
	oct 270000
	oct 300000
	oct 310000
	oct 320000
	oct 330000
	oct 760000		;]
	oct 350000
	oct 360000
	oct 370000
	oct 400000
	oct 410000
	oct 420000
	oct 430000
!!Page 100
	oct 440000
	oct 450000
	oct 460000
	oct 470000
	oct 500000
	oct 510000
	oct 520000
	oct 530000
	oct 540000
	oct 550000
	oct 560000
	oct 570000
	oct 600000
	oct 610000
	oct 620000
	oct 630000
	oct 640000
	oct 650000
	oct 660000
	oct 670000
	oct 700000
	oct 710000
	oct 720000
	oct 730000
	oct 750000		;[
	oct 750000		;[
	oct 760000		;]
	oct 770000		;End of translation table
	tcd lovwrt		;List transfer

	stl			;Reproducer
	ejt
!!Page 101
	org pernum
	dec 2
	dec c/c
,	Card reproducer
,	Will reproduce any type of card deck.
,	Buffered, with error checking.
,	Switch 0 down at any time will cause all
,	activity to halt.
,	Card read errors may be corrected by
,	placing the top card from the out stacker
,	(the last card read) in the read station
,	and toggling switch two.


	org execov
	dld .rst.,3		;Get entry
	spb insert,2	;and set up in list
	sta ovtsk
	sta z1
	lda 8K		;Set initialization entry
	sta rpoin
	bpr			;Crump if not ready
	bru *+4
	spb messg,2
	dec rpnr		;Punch not ready
	bru rcmpa
	bcr			;[Test card reader]
	bru *+4
	spb messg,2
	dec rcrn		;Reader not ready
	bru rcmpa
	lda cmessb		;Check batch flag
	bze			;If on continue, else
	spb messg,2		;acknowledge receipt
	dec pcr		;[Works because lda = 00]
	dld zero		;Zero out first syncwords
	dst io1+82
	rcf io1		;Read first card
	lac			;Compute first time delay
	add six
	sta rinf		;Save incremented time
	dld rads,3		;Buffer addresses
	dst rin
	bru rep		;and get out



rst:	ldx ovtsk,1		;Make like all other overlays
	ldz			;This is the entry point
	rcs			;Check switch 0 own
	bmi
!!Page 102
	bru 2,1		;Yes, crump for now
	ldx rpoin,2		;Get pointer
	bru 1,2		;and get there

rret:	stx rpoin,2		;Temporary exit
	ldx ovtsk,1
	bru 2,1



rep:	spb rret,2		;Give things a chance to come ready
	ldx rin,2		;area last read into
	bcn			;If reader not ready, check hopper
	bru rhop
	ldx rin+1,1		;Next area
	lda 82,2		;Darned card reader... check if out of phase
	ext rbit8,3		;bit 8
	bze			;if so, word before will have crap in it
	lda 83,2		;Check syncword
	add rsync,3
	bnz			;If not matched, reader error
	bru rderr
	sta 82,1		;and set in word again
	dld 0,2		;Check for quote cards
	dcb rquot,3
	bru *+2		;No
	bru rqchk		;Yes, check rest of card and flag
rnoq:	stx rin+1,2		;Else switch buffer addresses
	stx rin,1
	sta 83,1		;zero out [overwrite] next area's syncword
	wcf 0,2		;Punch previous card
	rcf 0,1		;read in next one
	bru rep		;and start all over


rhop:	lda 83,2		;Hopper empty test
	add rsynch,3
	bze			;If matched, task completed
	bru rcmplt
	lac			;Check clock
	cab rinf		;Has time run over...
	bru 2,1		;Just punt
	bru 2,1
	spb messg,2		;Else card reader not ready
	dec rcrn		;Card reader not ready
	lac			;Set up new time count
	add cr		;long wait
	sta rinf
	bru 2,1		;Punt again


!!Page 103
rqchk:lda cmessb		;Check back flag
	bze			;if not on, return
	bru rnoq
	dld rquot,3		;Ekse check out card some more
	dcb 2,2
	bru rnoq		;No
	bru *+2
	bru rnoq		;Neither
	dcb 4,2		;Then check last word
	bru rnoq		;Not Ok unless six 0-7-8 punches in a row
	bru *+2
	bru rnoq
rqex:	ldx ovtsk,1		;Get entry's location
	spb irase,2		;and erase entry
	ldx zero,2		;Reset 2
	inx batch,2		;and set to get batch monitor
	lmo
	sta io1		;Set front card in
	bru pgetb		;and get monitor


rcmpa:spb rret,2		;[Either reader or punch not ready at start]
	lda stack
	bnz
	bru 2,1
	lda cmessb
	bnz
	bru rqex
rcmplt:spb time,2		;Get time
	dst rdat1,3		;out away
	spb messg,2		;Type message
	dec repc		;Reproduction completed, time
	ldx ovtsk,1		;Get task
	spb irase,2		;and erase task
	ldz			;zero out flags
	sta bzyf
	sta ovtsk
	sta io1		;So batch does not get fouled up
	bru 2,1		;and exit


rderr:spb messg,2		;Type message
	dec rcre		;Card read error
	spb rret,2
	ldz
	rcs			;Wait for switch 2 down before continuing
	ext mask6
	sla 2
	bno			;Wait
	bru 2,1		;Not down
	ldx rin,2		;Pick up last-used read-in area
!!Page 104
	rcf 0,2		;read a card
	bru rep		;and start up again



.rst.:rpr			;If punch ready, go to task, else not
	spb rst,1
rads:	dec io1		;Buffer addresses
	dec io2
rouot:oct 1006
	oct 1007
rsync:oct 1770001		;Syncword OK check
rsynch:oct 0770001
rbit8:oct 4000		;Bit 8 for special bad card check

rpnr:	bss 0			;Punch not ready
	oct 374764
	alf NCH
	alf & NO
	alf T R
	alf EAD
	oct 703337
	oct 557777

rcrn:bss 0			;Card Reader not ready
	oct 372321
	alf RD
	alf REA
	alf DER
	alf & NO
	alf T R
	alf EAD
	oct 703337
	oct 557777

	oct 0
	ddc 0
	bss -3
repc:	bss 0			;Reproduction completed
	oct 375125
	alf PRO
	alf DUC
	alf TIO
	alf N C
	alf OMP
	alf LET
	alf ED.
	alf & & & 
rdat1:alf & & & 
	alf & & & 
!!Page 105
	alf & HO
	alf URS
	oct 373755

rcre:	bss 0			;Card read error
	oct 372321
	alf RD
	alf REA
	alf D E
	alf RRO
	alf R B
	alf ACK
	alf SPA
	alf CE
	alf 1 C
	alf ARD
	alf & AN
	alf D T
	alf OGG
	alf LE
	alf 2 W
	alf HEN
	alf & RE
	alf ADY
	oct 333755



	org t			;Temporary storage
rin:	bss 2			;Buffer areas flip-flop
rinf:	bss 1			;Initial flag
rpoin:bss 1			;Entry point
	tcd lovwrt		;Transfer

	stl			;Catalogue printout
	ejt
!!Page 106

,	The catalogue printout, disk dump and
,	Billing pack routines are all one package.
,	The billing and the catalogue routines may
,	be called separately by *BIL* or *CAT* res-
,	pectively but the usual sequence is to call
,	in the dump routine with *DUM*.  The dump
,	then calls in the catalogue and billing
,	routines.

,	Memory allocation for the disk dump package
,	is as follows...

,	Catalogue temporary storage
,	      4000 - 4077
,	Printer buffer areas
,	      4100 - 4477
,	Catalogue Buffer #1
,	      5000 - 6777
,	Catalogue buffer #2
,	      7100 - 11077
,	Disk dump catalogue file area
,	      11176 - 13177
,	Billing routine buffer area
,	      13300 - 16777
,	Billing temporary storage
,	      17000 - 17777
,	Catalogue file key
,	      20000 - 20577
,	Print line build area
,	      20700 - 20777
,	Catalogue routine
,	      21000 - 21777
,	Billing routine
,	      22000 - 22777
,	Disk dump buffer #1
,	      23076 - 27077
,	Disk dump buffer #2
,	      27176 - 33177

,	CMESS is used as a flag and has the
,	following code
,	   Bit 19 - dump in memory
,	   Bit 18 - catalogue in memory
,	   Bit 17 - billing in memory



pr:	eqo 4100		;Print line buffers [adrs end key-see CPL]
cin1:	eqo 5000		;Catalogue file buffers
cin2:	eqo 7100		;Catalogue files
!!Page 107
ckey:	eqo 20000
catw:	eqo 21000

jfile:eqo 11200
jbuf1:eqo 23100		;Buffer 1
jbuf2:eqo 27200		;Buffer 2

bin1:	eqo 13300		;Billing buffer area
biltmp:eqo 17000		;Billing temporary storage
billw:eqo 22000		;Billing program

lcr1:	eqo 23076
lcr2:	eqo 27176
ltap:	equ jfile
ltap1:equ ltap+28



	org pernum
	dec 4
	dec cat



	org execov
	lda three		;Ask time to stop [wow - wish I could do that]
	spb spmess,2
	lda six		;Ask for OFF
	spb spmess,2
	dld *+4,3		;Move catalogue down to where it should go
	mov execov
	bru cata		;and transfer it
	dec -1		;Spare
	dec catw		;All goes down
	dec -512



,	Catalog format

,	Each entry in the catalog is 8 words long
,	and containes information about a single
,	saved program in the following format...
,	Word 1 - first three characters of the user
,	         number.
,	Word 2 - second three characters
,	Word 3 - first three characters of problem
,	         name.
,	Word 4 - second three characters
,	Word 5 - beginning disk address of program
,	Word 6 - ending disk address of program
!!Page 108
,	Word 7 - coded date on which program was last
,	         accessed.
,	Word 8 - presently contains only length
,	         information - 0 if less than a half K,
,	         1 if greater.

,	The end of the entries in a given catalog is
,	signified by a 555555 appearing in word
,	2.  If more than 127 programs are saved by users
,	in a particular equivalence class, another
,	1024-word block will be added to the catalog.
,	The presence of another link is indicated
,	as follows...in word 2 of what would be the
,	128th entry will appear 373737.  The word
,	before this will be the disk address of the
,	added catalog.


	org catw+10
cata:	spb dskb,2		;Go ask for disk
	spb dskop,2		;Read in key to catalogue
	z12 6			;6 records, with labels
	dec ckey		;memory address
	z20 key+2		;inidirect to disk address
	bru *			;Should never ever return here
	spb messg,2		;Acknowledge request
	dec pcr

catb:	spb dksop,2		;Go read in date
	z12 1			;1 record
	dec cin1		;into area 1
	oct 400		;disk address
	dec -1		;Should never return here
	spb relin,2		;Give up disk
	lda cmess		;Set flag on to indicate calogue in
	add two
	sta cmess
	spb time,2		;Get time for heading line
	dst chead1,3
	sxg 5			;Set executive group
	set pst		;and exit priority mode
	bru *+1,3
	ldx 8K,3		;and make sure upper 8K bit is in right place
	dld cinit,3		;Get buffer flip-flops
	dst cin
	dld zero
	dst in
	sta cdass		;Reset save area for address
	ldx zero,2
	lda ovflo
	dst cpnum,2		;Set flag in program counters for decmode
!!Page 109
	inx 2,2
	bxl 16,2
	bru *-3
	lda nblnk		;Negative blank for print line
	sta p16,3
	sta perin		;Knock out indicator
	ext sign		;and reset sign bit
	lqa			;Copy in Q
	dst p*0,3		;and push over the line
	sta p1,3
	sta p2,3
	dst ptl,3
	inx 2,3
	bxl 40,3
	bru *-3
	lda mask6		;Set end of line
	sta ptl-2,3
	ldx 8K,3		;Reset register
	lda cin1		;Pick up dlong - long programs counter
	spb convrt,2	;convert it
	dst chdas2,3	;Put away in heading line
	lda cin1+2		;Pick up coded date
	spb convrt,2	;convert it
	dst chcode,3	;put away in next heading line
	dld ctdat,3		;Move constant for date
	mov cin1+3
	sxg 4			;and use all sorts of index groups
	ldx 8K,2		;Set some registers
	ldx 8K,3
	lda ckey,2		;Get first catalogue entry
	inx 1,2		;and step for next
	sta cfilea+2,3	;and set in parameter list
	sxg 3
	set pbk
	spb dramb,2		;Get catalogue
	dec cfilea		;File 1
	set pst
	sxg 5			;and get into some decent group
	spb slt8,2		;Slew to top of page
	spb slw3,2		;Slew page three lines
	lda linit,3		;Initialize line counter at eight
	sta cline
	bcs bpn,6		;Wait for printer ready
	bru *-1
	sel 6
	z26 --		;[What's this?]
	z02 chead,1		;Skip two lines when printing headers
	bcs bpn,6		;Wait again
	bru *-1
	sel 6
	z26 --
!!Page 110
	z02 chdass,1
	bcs brn,6		;Wait
	bru *-1
	sel 6
	z26 --
	z04 cdate,1		;Coded date heading line


cloop:lda cin+1		;Get next address
	sta xr52		;and set in register
	sta cmore+1,3	;and in indirect parameter
	sxg 4			;Get next catalogue address
	lda ckey,2
	inx 1,2
	sxg 5
	bmi			;Check the address
	bru crump1		;If negative, stop
	bze			;If zero
	bru cflip		;then print last entry and crump
	sta 2,2		;set in parameter list
	sxg 3
	set pbk

cmore:spb dramb,2		;Get catalogue
	z00 --		;Constructed indirect
	set pst
	sxg 5
	ldx cin,2		;Get last used file address
	lda 3,2		;and check done word
	bze			;Wait for disk to finish
	bru *-2
	bev			;If error, stop so we can see what and where
	dec -1
cflip:lmo			;Set print flag
	sta pflag
	dld cin		;Switch buffers
	xaq
	dst cin
	ldx cin+1,2		;Last entry is now +1
	lda 1,2		;Get memory address
	sta xr52-1
	lda 2,2		;and get address
	sta cadrs		;save it for later

cscan:lda 1,1		;Check for 55s in second word
	cab c55s,3
	bru *+2		;If not, continue
	bru cloop		;Else try again
	cab c37s,3		;See if one of Kip's crazy catalogs
	bru *+2
	bru ccon		;Yep
!!Page 111
	lda bzyf		;Check for crump
	bze			;If so, then flag will be zero
	bru wait		;so get out
	lda pflag		;Look at print flag
	bze			;If zero, special case
	bru pset		;Wipe out disk address
	bpl			;If non-zero plus, get out
	bru pnext
	lda ovflo
	sta p3,3
cconk:bss 0
	lda cadrs
	spb convrt,2
	sta p*0+1,3		;Move address over
	xaq
	sta p0,3
	lda zero
	sta pflag

pnext:lda p3,3		;Increment counter
	set pbk
	set decmode		;for decimal mode arithmetic
	add one
	set binmode
	set pst
	sta p3,3		;Put away counter
	dld 2,1		;Problem number
	dst p6,3
	lda 4,1		;Starting disk address
	ext mask1		;Check for legal address
	cab o300
	bru *+3
	bru *+1
	spb cerr,2		;No
	lda 4,1		;Get address again
	cab cdass		;Check against last highest available
	bru *+3		;location for saved programs
	bru *+2
	sta cdass
	spb convrt,2	;Convert it
	dst p8,3
	lda 5,1		;Ending disk address
	sub 4,1		;Compute length of program
	bze
	spb cerr,2		;Zero-length is illegal
	bmi			;Check if length all wrong
	spb cerr,2		;Yes
	cab o100		;Or out of bounds
	bru *+3
	bru *+2
	spb cerr,2		;Yes
!!Page 112
	dld 0,1		;User number
	dst p4,3		;put away
	sub c77s,3		;and see if hole
	bze
	bru pnoc		;If so, do not count it
	set pbk
	set decmode		;Decimal mode for counting problems
	lda 7,1		;Length code
	ext mask3		;just low end of interest
	sla 1			;Double length table
	sta xr52		;In group 5
	dld cpnum,2
	dad cone,3		;Increment
	dst cpnum,2
	set binmode
	set pst
pnoc:	lda 5,1		;Pick up ending disk address again
	spb convrt,2
	dst p10,3
	lda 6,1		;Pick up coded date
	spb convrt,2
	dst p12,3
	lda 7,1		;Pick up unused word
	spb convrt,2	;convert'
	dst p14,3
	lda cerrf		;Check error flag
	bmi
	spb cerr1,2
	dld pprnt,3		;Get number of words in Q
	lda cpl,3		;Get currently used buffer address
	add o200		;Switch it
	ext o400
	sta cpl,3		;and restore
	mov P*0		;Move into print area
	bcs bpn,6		;Wait for printer
	bru *-1
	sel 6
	z36 cform,1		;Format line
cpl:	z01 pr		;Print line
	inx 8,1		;Increment area pointer
	lda cline		;Check if slew necessary
	add one
	sta cline		;put away incremented counter
	cab c57,3		;57 lines per page
	bru cscan		;If less, go scan again
	lda three		;Else reset counter
	sta cline		;and slew page
	spb slt8,2		;Slew to top
	bcs bpn,6		;Wait for printer
	bru *-1
	sel 6
!!Page 113
	slw 1			;Slew one line at top
	lda ptl1,3		;and get page
	set pbk
	set decmode		;Count [page number]
	ado
	set binmode		;get back
	set pst
	sta ptl1,3
	bcs bpn,6		;Wait again
	bru *-1
	sel 6
	z26 --
	z03 ptl,1		;Title print
	bru cscan		;go scan


pset:	lda dumpbl		;Blanks
	sta p*0+1,3		;Wipe out disk address
	sta p0,3
	sta p1,3
	sta pflag		;Reset flag to positive
	bru pnext		;Get back


,	This is used to fudge the right catalog when
,	a linked one is found.  It reads the linked
,	catalog over the one it just listed and
,	then lists it.
ccon:bss 0
	ldx cin+1,2
	lda 1,2		;Fudge right catalog
	sta cconl+1,3
	lda 0,1
	sta cconl+2,3
	sta cadrs
	set pbk
	spb dramb,2
	dec cconl
	set pst
	lda cconl+3,3
	bze
	bru *-2		;Wait till done
	bev
	bru *			;[Hang on error]
	lda cconl+1,3
	sta xr52-1
	bru cconk

,	Catalog printout finished, determine next
,	available location and number of programs.
!!Page 114

crump1:spb slw3,2		;Slew three lines
	lda cdass		;Next available location for saved programs
	add o100		;round up
	sta cdass		;save
	ext mask1		;Check legality
	sub o300
	bpl			;Bad
	bru *+3
	ldz			;OK
	bru *+2
	lda o100
	add cdass		;Get good address
	spb convrt,2	;convert it
	dst ccom2,3		;put away
	bcs bpn,6
	bru *-1
	sel 6			;Print it
	z26 --
	z02 ccom1,1
,	Now start totalling progams
crump2:ldx zero,2		;Loop counter
	bcs bpn,6		;Wait at start
	bru *-1
	dld cpnum,2		;Number of programs
	cab ovflo
	bru *+1
	add cig1,3		;Delete right number of characters
	add cig2,3
	dst ctotp,3		;Total programs
	set pbk
	set decmode
	dld cpnum,2
	dad ctot6,3 	;Keep total programs
	dst ctot6,3
	set binmode
	set pst
	lda xr52		;Get counter
	sra 1
	add cig2,3		;Do not want zeros
	sta cend1,3		;Put in print line
	sel 6			;Print it
	wpl cend1
	inx 2,2
	bxl 12,2
	bru crump2+1	;Start again
	spb slw3,2		;Slew three lines
	dld ctot+6,3	;Get rid of high-order zeros on this too
	cab ovflo
	bru *+1
!!Page 115  10/3/02
	add cig1,3
	add cig2,3
	dst ctot6,3
	bcs bpn,6
	bru *-1
	sel 6			;Print total programs
	z24 --
	dec ctot
	spb slt8,2
	lda cmess		;Delete catalogue from roster
	sub two
	sta cmess
	bnz
	bru wait		;Yes, so crump
	bru icrump		;and type message


cerr:	lmo			;Set flag
	sta cerrf,3
	bru 1,2		;and get out
cerr1:dld ****,3		;Get asterisks
	dst p12,3		;and set in last words
	dst p14,3
	ldz			;Reset flag
	sta cerrf,3
	bru 1,2		;and get out


slw3:	bcs bpn,6		;Wait
	bru *-1
	sel 6
	slw 3
	bru 1,2


slt8:	bcs bpn,6
	bru *-1
	sel 6
	slw 8
	bru 1,2

,	Constants



cfilea:z12 16		;Read, 16 records - file parameter list
	dec cin1		;Area 1
	z00 --		;Constructed disk address
	z00 --		;Special terminate word
!!Page 116

cfileb:z12 16
	dec cin2
	z00 --
	z00 --



cconl:z12 16
	z00 --
	z00 --
	z00 --


c37s:	oct 373737
c57:	dec 57		;Number of lines per page
c77s:	oct 777777
****:	alf ***		;Special indicators
	alf ***
cinit:dec cfilea		;Areas flip flop
	dec cfileb
ctdat:dec chead2		;Move constant for date
	dec -5
cone:	oct 0
	oct 1
pprnt:dec 0			;Print move constant
	dec -19
c55s:	oct 555555
linit:dec 11		;Initial value for line counter
cerrf:oct 0			;Flag
cig1:	oct 35
cig2:	oct 603500

,	Format line

cform:oct 353535
	oct 353535
	oct 353535
	oct 353535
	oct 373757
	oct 353535
	oct 363535
	oct 353535
	oct 363535
	oct 353535
	oct 363535
	oct 353535
	oct 363535
	oct 353535
	oct 363535
	oct 353535
!!Page 117
	oct 363535
	oct 353535
	oct 353535

,	General heading line

	oct 0			;Make into odd location
	ddc 0
	org *-3
chead:alf DAR		;Dartmouth College Time-Sharing System
	alf TMO		;Catalogue files as of   date
	alf UTH
	alf & CO
	alf LLE
	alf GE 
	alf TIM
	alf E-S
	alf HAR
	alf ING
	alf & SY
	alf STE
	alf M C
	alf ATA
	alf LOG
	alf UE 
	alf FIL
	alf ES 
	alf AS 
	alf OF
chead2:alf & & & 		;Date goes in these five locations
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & T
	alf IME
chead1:alf & & & 		;Time goes in these two locations
	alf & & & 
	alf & HO
	alf URS
	oct 2336060

,	Second heading line

	oct 0			;Make sure chdass is even
chdass:oct 353545		;[Next available location for saved ]
	alf EXT		;[programs is]
	alf & AV
	alf AIL
	alf ABL
!!Page 118
	alf E L
	alf OCA
	alf TIO
	alf N F
	alf OR 
	alf SAV
	alf ED 
	alf PRO
	alf GRA
	alf MS 
	alf IS
chdas2:alf & & & 		;Dassgn foes in these two locations
	alf & & & 
	oct 2336060

,	Third heading line

cdate:oct 353523		;Coded date--
	alf ODE
	alf D D
	alf ATE
	oct 404060
chcode:alf & & & 		;Coded date goes in these two locations
	alf & & & 
	oct 2336060

,	Computed next available location

ccom1:alf COM
	alf PUT
	alf ED 
	alf NEX
	alf T A
	alf VAI
	alf LAB
	alf LE 
	alf LOC
	alf ATI
	alf ON
	OCT 601660		;Equal sign
	oct 353535		;Ignores
ccom2:alf & & & 
	alf & & & 
	oct 2336060

,	Terminating lines for catalog printout

cend1:alf & & & 
	alf & LE
	alf NGT
	alf H P
!!Page 119
	alf ROG
	alf RAM
	alf S =
ctotp:alf & & & 
	alf & & & 
	oct -336060
	oct 0			;Make next even
ctot:	alf & TO
	alf TAL
	alf & PR
	alf OGR
	alf AMS
	alf & =
ctot6:ddc 0
	oct -336060

,	Print line build area

	loc 20700
p*0:	bss 2			;Leading blanks
p0:	bss 1
p1:	bss 1
p2:	bss 1
p3:	bss 2
p4:	bss 2
p6:	bss 2
p8:	bss 2
p10:	bss 2
p12:	bss 2
p14:	bss 2
p16:	bss 1
ptl:	bss 40		;Save 40 places for title
ptl1:	equ ptl+38

,	Temporary storage

	org k6area
cin:	bss 2
cpnum:bss 16		;Counters for programs
cdass:bss 1
cadrs:bss 1
pflag:bss 1
cline:bss 1


	org k2area		;Special fudging routine
excv:	equ execov
	dec excv+10
	dec -502
catmov:dld *-2		;Move catalogue up for loading onto disk
!!Page 120
	mov cata
	bru lovwrt		;and go write overlay

	tcd lovwrt

	stl			;Disk dump
	ejt
!!Page 121

,	Time-sharing disk dump.
,	The following areas will be dumped...
,	1) The first half of disk zero
,	2) The catalogue files
,	3) All saved programs
,	Usually only one tape will be required,
,	and it should be mounted on handler 3.
,	If a second tape were to be required, the
,	program will ask for it via the console
,	typewriter and wait for zero to be toggled.
,	The second tape must be placed on handler
,	7.  In this case tape three will have to
,	be rewound manually.
	org pernum		;Heading information
	dec 6
	dec dum

	org execov
	lda three		;Ask for time count stop
	sbp spmess,2
	lda six		;Ask for OFF
	spb spmess,2
	lda wait1		;Reset P-counter
	sta pct
	lmo			;Reset some indicators
	sta perin		;Peripheral indicator
	sta in		;System indicator
	ldo			;Set cmess
	sta cmess
	spb dskb,2		;Ask for disk
	spb dskop,2		;and read in tape routine
	z12 3			;300 octal words
	dec treqst
	z20 tap+2		;Indirect to disk address
	bru *			;Should never happen
	spb treqst,2	;Then use it
	sel 1			;to rewind tape 3
	rwd ,3
	oct 0			;Flag to indicate return
	spb dskop,2		;Read in catalogue routine
	z12 8			;1K octal
	dec catw
	z20 cat+2		;Indirect to address
	bru *			;Neither should it return here
	spb dskop,2		;Read in key to catalogue
	z12 6			;6 records, with labels for dump
	dec ckey		;Key area
	z20 ckey+2		;Indirecto to disk address
	bru *			;Real trouble if it returns here
!!Page 122
	spb dskop,2		;Read in billing routine
	z12 8
	dec billw
	z20 bil+2		;Indirect to disk address
	bru *
	dld .jlnk.,3	;Get linkage to dump routine
	spb insert,2	;and insert in task list
	sta jlist		;Save entrance
	bru catb		;and transfer to catalogue


,	JLNK is entered after the catalogue routine
,	is initialized, and it writes labels on
,	tapes and types them out and does other odd
,	things.


jlnk:	lda 1,1		;Switch entries for rest of time
	sta 0,1
	dld jinit,3		;Points to jfila, jfileb
	dst jin
	spb dramb,2		;Pick up first 2K from disk zero
	dec jfila
	dld lab3		;Get date
	mov sdate+1
	spb time,2		;and time
	dst dlab2,3
	lmo			;Set flag word negative
	sta dlab5		;to indicate tape #1
	spb jexec,2		;and exit with return saved
	bcs brw,1		;Wait for tape to finish rewinding
	bru 2,1		;If so [rewinding], exit
	spb billi,2		;Initialize billing routine
	spb treqst,2	;Write label
	sel 1
	wtb dlab1,3
	    %30
	oct 0
	spb jexec,2		;Do not overload task table
	lda *-2
	bze			;If label not done, crump
	bru 2,1
	spb messg,2		;and type message
	dec dlab1		;label
	spb messg,2		;and time
	dec dumtim



,	JLOOPA reads in the first half of disk zero
,	and writes it on the dump tape
!!Page 123



jloopa:spb jexec,2	;Exit
	ldx jin,2		;Points to current file
	spb jchk,0		;See if any errors
	spb jtape,1		;Go write records on tape
	ldx jin,2		;Get file addresses again
	ldx jin+1,1
	lda 2,2		;Disk addresses
	cab jlast,3		;and check for end first half disk zero
	bru *+2
	bru jlba		;exit if so
	add o100		;Step 2K
	sta 2,1		;and set in next file
	ext mask1		;Check for illegal
	cab o300
	bru *+5		;OK
	bru *+1		;No, so step position
	lda 2,1
	add o100
	sta 2,1
	stx jin+1,2		;Flip flop buffer addresses
	lda z1		;Get next one
	sta jin
	sta *+2,3		;and set in calling pointer
	spb dramb,2		;Pick up next 2K
	dec jfilb
	bru jloopa		;and get next


,	JLBA picks up catalogue files as indicated
,	by addresses in the key.


jlba:	ldx 8K,2		;Begin saved programs dump
	stx jkey,2		;Initialize catalogue pointer
jlbb:	ldx jkey,2		;Get file pointer
	lda ckey,2		;and entry for file
	bze			;Check for all done
	bru jend		;Yes, so terminate dump
	inx 1,2		;Step pointer
	stx jkey,2		;and save
jlcn:	sta jfilc+2,3
	spb jexec,2		;Now exit
	lda jtflg,3		;and check to make sure last entry written
	bze			;on tape if one file empty
	bru 2,1		;Wait if not
	spb dramb,2		;If OK, bring in file
jlfdg:dec jfilc		;Fudge factor
	spb jexec,2		;and exit
!!Page 124
	lda jdfilc,3
	sta z2
	spb jchk,0		;See if any errors
	lda jlfdg,3		;Get fudge constant
	sta z2		;and set in register 2
	spb jtape,1		;Write file on tape
	lda jfilc+1,3	;Get memory address and initialize running
	sub jeig		;dec 8
	sta jkvar		;pointer
	sta z2		;and set in register
	bru jl1;		;and begin saving programs


,	JLOOPB picks up saved programs according to
,	the entries in each individual catalogue
,	file, and writes them out onto the dump
,	tape.


jloopb:spb jexec,2	;Exit
	ldx jin+1,2		;Get current entry pointer
	spb jchk,0		;See if any errors
	spb jtape,1		;Write out just-read program
jl1:	ldx jkvar,2		;Get running pointer
	inx 8,2		;and step
	stx jkvar,2		;save
	lda 1,2		;Check for end file
	cab c37s		;check linked catalo
	bru *+2
	bru jl2		;Get next link
	cab j55s		;See if end of catalog file
	bru *+2		;No
	bru jlbb		;Get next catalog record
	cab c77s,3		;See if hole
	bru *+2		;No
	bru jl1		;Yes, just skip it
	lda 4,2		;Get starting disk address
	ext mask1
	cab o300		;Check for legal
	bru *+3
	bru jl1		;No, crump it
	bru jl1
	lda 5,2		;Get length
	sub 4,2
	sra 1			;Mod 64
	bpl			;Check if bad length, such as
	bze			;zero
	bru jl1		;or negative
	cab o40		;or too long
	bru *+3
	bru *+2
!!Page 125
	bru jl1
	ldx jin+1,1		;Get pointer to next parameter list
	sto 0,1		;and set length in command
	lda 4,2		;Get address again
	sta 2,1		;and set in parameter list
	dld jin		;Flip entries
	xaq
	dst jin
	sta *+2,3		;and in call
	spb dramb,2		;Now read a program
	dec 0			;Constructed parameter list pointer
,	These are fudges for buffering.  Skip
,	write out prgram first time through and
,	make sure last one gets written
	lda *+4,3		;Get branch for next time
	sta *-1,3
	sta jloopb-1,3	;Make sure last program gets written
	bru jl1		;and get next program
	bru jloopb		;Normal entrance

jl2:	lda 0,2		;This is a fudge to get extended catalog
	bru jlch		;and get it

,	JTAPE is entered on xreg1.  Index register 2
,	points to the disk parameter list
,	containing the information about the record
,	to be written on the tape.
,	This information becomes part of each tape
,	record in a special two-word key at the
,	beginning of each one, as follows.

,	   word 1 - disk address
,	   word 2 - length (mod 64)


jtape:stx jtmp,1		;Save entrance
	stx jtmpp,2		;and save other
	spb jexec,2		;and exit
	lda jtflg,3		;Get completion flag
	bze			;If zero, not yet done
	bru 2,1
	sra 1			;Check for end of tape
	bod
	bru jswtch		;in which case change tapes
jt2:	ldx jtmpp,2		;Get file pointer
	lda 1,2		;and get memory address
	sub two		;decrement for key
	sta z1		;and set in register
	lda jtap+2,3	;Get operation
	ext mask11		;less address
	add z1		;and add memory address
!!Page 126
	sta jtap+2,3	;Then set in call
	lda 0,2		;Get length
	ext mask10		;extract high-order end
	sta 1,1		;and set in key
	sla 6			;and set as # of records
	add two		;incremented for key
	sto jtap+3,3	;in call
	lda 2,1		;Set disk address in key
	sta 0,1
jtap:	spb treqst,2	;Write record on tape
	sel 1
	wtb --,3		;Constructed
	    %0
jtflg:oct 1			;Flag word - initialized
	ldx jtmp,1		;Get return
	bru 1,1		;and return



jexec:stx jpoin,2		;Save caller
	ldx jlist,1		;Get entrance point
	bru 1,2		;get back

jent:	ldx jpoin,2		;Get caller
	bru 1,2		;and return



jswtch:lda jtap+3,3	;Check for tape 7 already
	bmi			;If so, real trouble
	bru jtroub
	spb messg,2		;Else type message to change tapes
	dec t07
	lda sign		;Now switch handlers
	ory jtap+3,3
!!***************************************************
!!JSM: ERROR: the instruction below was
!!    ory jend+3,3
!!which is clearly wrong.  It is
!!part of a sequence contructing a tape operation,
!!but as originally written, this instruction would
!!place a sign bit into a location whose contents are
!!     spb jtape,1
!!creating an unintended (and probably illegal)
!!instruction.  The intent was to indicate whether
!!a tape rewind operation should address handler
!!3 or 7, as indicated by the comment at location
!!'jend' + 9 (circa line 5321), so I created a symbol
!!jend0 at that location and changed the original
!!instruction as shown below.
!!***************************************************
	ory jend0+3,3	;[jsm: *** CLEARLY AN ERROR *** was jend0+3]
	ory jend1+3,3
	spb treqst,2	;and rewind old tape
	sel 1
	rwd ,3
	oct 0
	spb jexec,2		;Exit
	ldz			;and wait for 2 to be toggled
	rcs
	sla 2
	bno
	bru 2,1		;Exit if not down yet
	ldz			;Set flag for second label
	sta dlab5.3
	spb treqst,2	;and write it on second tape which had better
!!Page 127
	sel 1			;be rewound
	wtb dlab1,7		;Write label out on 7
	    %30
	oct 0
	spb jexec,2		;Exit and wait for label to be done
	lda *-2
	bze
	bru 2,1
	bru jt2

jtroub:spb messg,2	;Type message and abort run
	dec psoo

,	JEND must write out the last program which is
,	still in memory

jend:	spb jexec,2		;Exit first
	ldx jin+1,2		;Get current file entry pointer
	spb jchk,0		;Check disk
	spb jtape,1		;Write on tape
	spb jexec,2		;Exit again
	lda jtflg,3		;Check done
	bze
	bru 2,1		;Not yet
jend0:spb treqb,2		;Now rewind 3 - or 7 as may be
	sel 1			;and write end-of-file on three - or 7
	wef ,3
	oct 0
jend1:spb treqb,2
	sel 1
	rwd ,3
	oct
	spb jexec,2		;Exit and wait
	lda *-2,3		;Keep checking
	bze			;punt if not done
	bru 2,1
	lda cmess		;Decrement flag to indicate completion
	sbo
	sta cmess
	sra 2			;Check for billing in
	bev
	spb tclos,2		;If not, close out tape routine
	ldx jlist,1		;Get entry point
	spb irase,2		;and erase
	lda cmess
	bze			;Check if billing or catalogue still in
	bru icrump		;if none, exit and type message
	bru 2,1		;Exit

!!Page 128
jchk:	lda 3,2		;Check for file read
	bze
	bru 2,1		;If not, punt
	stx rawt,0		;Save entrance
	bev			;Hang if any errors
	bru *			;not recovered
	ldx rawt,1
	bru 1,1		;Return


,	Disk parameter lists


jfila:z12 32		;Read in first half of disk zero
	dec jbuf1		;into buffer #1
	dec 0			;constructed
	dec 0			;completion indicator

jfilb:z12 32		;Read 2K
	dec jbuf2		;Buffer 2
	dec 0			;constructed
	dec 0			;completion indicator

jfilc:z12 16		;Special file for catalogues
	dec jfile
	dec 0
	dec 0



.jlnk.:spb jlnk,1		;Linkage entry for first time
	spb jent,1		;subsequent times entry
jinit:dec jfila		;Files flip flop
	dec jfilb
jdfilc:dec jfilc
dlab3:dec dlab		;Date move
	dec -5
jlast:oct 37600		;Last record on disk zero
j55s:	oct 555555
jeig:	dec 8			;Start jkvar off right

,	**********************************************
,	Do not go above 37500--tape sub. overlay
,	**********************************************



	org ta		;Leave treqst some room
jin:	bss 2
jlist:bss 1
jkey:	bss 1
!!Page 129
jkvar:bss 1
jtmp:	bss 1
jtmpp:bss 1
jpoin:bss 1
	tcd lovwrt		;Transfer

	stl			;Billing master pack
	ejt
!!Page 130  10/4/02
,	The billing master packing routine writes an
,	end-of-file on tape 0, rewinds 0 and 6,
,	then spaces forward 6 until it senses an
,	end-of-file.  It then packs tape 0 onto 6,
,	blocking the latter by a factor of ten.
,	If called by *BILL*, it moves itself down to
,	22000, but normally it is read in by the
,	dump routine and is part of the dump -  cat
,	- billing package.


	org pernum
	dec 8
	dec bil


	org execov
	lda three		;Ask for off
	spb spmess,2
	lda six		;Turn off other teletypes
	spb mess,2
	dld *+4,3		;Move program down
	mov execov
	bru billa
	dec -1		;Spare word
	dec billw
	dec -512		;Lots of words...P


	org billw+10
billa:lda wait1		;Reset P-counter
	sta pct
	spb messg,2		;and acknowledge
	dec pcr
	spb dskb,2		;Get disk to read in tape routine
	spb dskop,2		;and read in tape routine
	z12 3
	dec treqst		;Upper part of overlay
	z20 tap+2		;Indirect to its address
	bru *			;This should never happen
	spb relin,2		;Relinquish disk, so we can get it later
	dld .blii.,3	;Get entry
	xaq
	spb insert,2	;and insert in table
	sta bilin		;and save


billb:spb treqb,2		;Normal running routine
	sel 1			;Write end-of-file on zero
	wef ,0
!!Page 131
	oct 0			;Return flag
	spb treqb,2		;and rewind 6
	sel 1
	rwd ,6
bilrw:oct 0			;Flag for completion
	lmo			;Reset some indicators
	sta pering
	sta in
	lda cmess		;Set cmess to indicate billing in
	add four
	sta cmess
	spb bexec,2		;Exit and return
	lda bilrw,3		;to check if rewind of 6 done
	bze
	bru 2,1		;No, so exit
	bcs brw,1		;Wait for rewind
	bru 2,1
	spb treqb,2		;Go rewind zero
	sel 1
	rwd ,0
bilw0:oct 0
bilsum:spb bexec,2	;Reset summary
	spb irase,2
	spb dskb,2
	spb dskop,2		;Read in summary
	z12 1
	dec fclock
	oct 402
	nop
	ldz			;Reset first word
	sta fclock
	spb dskop,2		;Re-write summary
	z37 1
	dec fclock
	oct 402
	nop
	dld .blii.,3	;Restore billing
	xaq
	spb insert,2
	sta bilin
	spb relin,2		;Done with disk
blsrch:spb treqb,2	;Go search for end of master
	sel 1
	rtb bin1,6		;Read in record
	    %0		;but not much
blsrw:oct o			;Flag word
	spb bexec,2		;Exit and wait
	lda blsrw,3		;Check flag on read
	bze
!!Page 132
	bru 2,1		;Crump if not done
	sra 2			;Check for EOF
	bev
	bru blsrch		;None
	spb treqb,2		;Now begin copying 0 onto 6
	sel 1
	bkw ,6		;Backspace 6 over EOF
	oct 0
	spb bexec,2		;Exit and wait
	lda *-2,3		;Check flag
	bze
	bru 2,1		;exit
	lda bilw0,3		;Check flag on that op
	bze
	bru 2,1		;Crump if unattended
	bcs brw,1		;else wait for rewind
	bru 2,1


bill3:spb treqb,2		;Begin reading and search for BOO messg
	sel 1
	rtb bin1,0
	    %30
	oct 0
	spb bexec,2		;Exit and wait
	lda bill3+4,3
	bze			;Check flag
	bru 2,1		;exit if not yet done
	dld bin1		;Else check for message
	dsu boo1,3
	bze			;First word zero
	xaq			;Check second
	bnz			;Either non-zero,
	bru bill3		;keep at it


,	BILL4 reads in records from the billing
,	scratch tape, discards all debbuging info,
,	then packs the good records in 20-record
,	blocks which get written onto the packed
,	billing tape, on 6.



bill4:lda bin2,3		;Get address
	ldx zero,1		;and initialize counter
	stx binf,1		;save
	bru *+3		;and skip first part


!!Page 133
bill5:lda bin,3		;Get address
	add b24,3		;Step it
	sta bin,3		;and save
	sto *+3,3		;and set in call
bill5r:spb treqb,2		;Read tape zero
	sel 1
	rtb --		;Constructed
	    %24
	oct 0			;Flag word
	spb bexec,2		;Exit and wait
	lda *-2,3
	bze			;Exit if not done
	bru 2,1
	sra 2
	bod			;Check for end-of-file
	bru bill8		;Found, so end near
	lda bin,3		;Get address
	sta z2		;set in register
	lda 24,2		;Get residue word
	bnz			;and check for greater or less
	bru bill5r		;Crump if not 24 words
	ldx binf,1		;Get counter
	inx 1,1		;step it
	stx binf,1		;and save
	bxl 20,1		;Check for 20
	bru bill5		;no, so go back and read some more
	spb treqst,2	;This time check for errors
	sel 1
	wtb bin1,6		;Write many records
	    %480
	oct 0
	spb bexec,2		;Exit and wait
	lda *-2,3		;Now wait
	bze
	bru 2,1		;and exit if not done
	bru bill4		;else restart sequence



bill8:spb treqb,2		;Wrapup operation
	sel 1
	rwd ,0		;Rewind zero
	oct 0			;Flag word
	lda binf		;Get last-used address counter
	bze			;Check for none written this time
	bru bill9		;EOF came first, so exit
	maq
	mpy b24,3		;Else get number of words left
	laq			;Pick them up
	sto *+4,3		;and put away in call
!!Page 134  10/5/02
	spb treqst,2	;and write on billing tape last time
	sel 1
	wtb bin1,6
	    %0		;constructed
	oct 0

bill9:spb treqb,2		;Pile them up
	sel 1
	wef ,6		;Write EOF on 6
	oct 0
	spb treqb,2		;and some more
	sel 1
	rwd ,6		;Rewind 6
	oct 0
	lda cmess
	sub four		;Delete billing from roster
	sta cmess
	bev			;Check if dump still in
	spb tclos,2		;Else close out tape
	ldx bilin,1		;Get entrance
	spb irase,2		;and erase
	lda cmess		;Get again
	bze			;Check if any in
	bru icrump		;and type message if none
	bru 2,1		;and exit



billi:dld .blii.,3	;Get first entry
	bru insert		;and exit



blii:	stx bilin,1		;Save entry
	lda .blin.,3	;Get usual entry
	sta 0,1		;and set in list
	bru billr		;and initialize operations



blin:	ldx bpoin,2		;Get exit point
	bru 1,2		;and get going


bexec:stx bpoin,2		;Save exit point
	ldx bilin,1		;and get entry point
	bru 1,2		;and exit


!!Page 135

.blii.:spb blii,1		;Bill initializer
.blin.:spb blin,1		;Regular billing entry
boo1:	oct 2606060		;Special check constant
	oct 557755
bin2:	dec bin1		;Buffer address
b24:	dec 24
bin:	bss 1			;Address


	org biltmp		;Temporary storage
binf:	bss 1			;Counter
bilin:bss 1			;Entry point save
bpoin:bss 1			;Exit pointer



	org k2area		;Fudge routine
	dec excv+10
	dec -502
bilmov:dld *-2		;Move billing routine up so can write on disk
	mov billa
	bru lovwrt		;and transfer
	tcd bilmov

	stl			;Catalogue files key
	ejt
!!Page 136

,	Cataogue files key.

,	Contains in addition certain labels for the
,	dump and load routines.
,	This overlay is read in by the catalogue
,	into 20000



	org pernum		;Special overlay called by dump and catalogue
	dec 10
	dec key



	org ckey
,	Key to the catalog
,	Disk 1
	oct 061400
	oct 061440
	oct 061500
	oct 061540
	oct 061600
	oct 061640

,	Disk 2
	oct 121400
	oct 121440
	oct 121500
	oct 121540
	oct 121600
	oct 121640

,	Disk 3
	oct 161400
	oct 161440
	oct 161500
	oct 161540
	oct 161600
	oct 161640

,	Disk 4
	oct 221400
	oct 221440
	oct 221500
	oct 221540
	oct 221600
	oct 221640

,	Disk 5
	oct 261400
	oct 261440
	oct 261500
	oct 261540
	oct 261600
	oct 261640

,	Disk 6
	oct 321400
	oct 321440
	oct 321500
	oct 321540
	oct 321600
	oct 321640

,	Disk 7
	oct 361400
	oct 361440
	oct 361500
	oct 361540
	oct 361600
	oct 361640

,	Disk 8
	oct 421400
	oct 421440
	oct 421500
	oct 421540
	oct 421600
	oct 421640

,	Disk 9
	oct 461400
	oct 461440
	oct 461500
	oct 461540
	oct 461600
	oct 461640

,	Disk 10
	oct 521400
	oct 521440
	oct 521500
	oct 521540
	oct 521600
	oct 521640

,	Disk 11
	oct 561400
	oct 561440
	oct 561500
	oct 561540
	oct 561600
	oct 561640

,	Disk 12
	oct 621400
	oct 621440
	oct 621500
	oct 621540
	oct 621600
	oct 621640

,	Disk 13
	oct 661400
	oct 661440
	oct 661500
	oct 661540
	oct 661600
	oct 661640

,	Disk 14
	oct 721400
	oct 721440
	oct 721500
	oct 721540
	oct 721600
	oct 721640

,	Disk 15
	oct 761400
	oct 761440
	oct 761500
	oct 761540
	oct 761600
	oct 761640
,	Extra catalogs on disk 15
	oct 761000
	oct 761040
	oct 761100
	oct 761140
	oct 761200
	oct 761240

	oct 760400
	oct 760440
	oct 760500
	oct 760540
	oct 760600
	oct 760640
	oct 0			;End for dump
	dec -1		;End for catalogue printout
!!Page 139


,	Labels for dump and load


	ddc 0			;Insure even
	bss -2
dlab1:bss 0			;Dartmouth College Time-Sharing System
	oct 377777
	alf DAR
	alf TMO		;Disk dump-load tapes.  Date
	alf UTH
	alf & CO
	alf LLE
	alf GE 
	alf TIM
	alf E-S
	alf HAR
	alf ING
	alf & SY
	alf STE
	alf M D
	alf ISK
	alf & DU
	alf MP-
	alf LOA
	alf D T
	alf APE
	alf S.
	oct 606037
dlab:	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	oct 375577
dlab5:oct 0			;This word indicates which tape is on


	oct 0			;Must be odd location
	ddc 0
	bss -3
dumtim:bss 0
	alf DIS
	alf K D		;Disk dump time  etc.
	alf UMP
	alf . T
	alf IME
dlab2:alf & & & 
!!Page 140
	alf & & & 
	alf & HO
	alf URS
	oct 373755

to7:	bss 0			;Place tape 2 on handler 7.  Toggle zero
	oct 374743		;when ready.
	alf ACE
	alf & TA
	alf PE 
	alf 2 O
	alf N H
	alf & 7.
	alf & & T
	alf OGG
	alf LE 
	alf 2 W
	alf HEN
	alf & RE
	alf ADY
	oct 333755

psoo:	bss 0			;Tapes on wrong density.
	alf PES
	alf & ON
	alf & WR
	alf ONG
	alf & DE
	alf NSI
	alf TY.
	oct 375577


,	Fudge routine to move overlay up



	org k2area
	dec execov
	dec -512
filmov:dld *-2
	mov ckey		;and move
	bru lovwrt		;Now write on disk
	tcd filmov

	stl			;Disk load
	ejt


	org pernum
	dec 12
	dec loa



,	Time-sharing disk load.  This routine ex-
,	pects each record on the tape to have two
,	code words at the beginning, with the
,	following information...

,	   Word 1 - disk address
,	   Word 2 - length (mod 64)


,	      Tape one of the load set must be
,	mounted on handler 3.  The tape will be
,	transferred to the disk until an end-of-
,	file is sensed, at which point the load
,	terminates.  If an EOF is sensed before the
,	EOF is reached, the program will ask to have
,	the second tape from the load set mounted
,	on handler #7.
,	      The first tape must have the correct
,	label written on it by the dump routine and
,	the last word of this must be negative.  For
,	second tape, the label is the same but the
,	code word is zero.

,	Memory layout is the same as for the dump
,	routine.

	org execov


	lda three		;Ask for time count stop
	spb spmess,2
	lda six		;Ask for OFF
	spb spmess,2
	lda wait1		;Reset counter
	sta pct
	spb messg,2		;Acknowledge
	dec pcr
	spb dskb,2		;Ask for disk
	spb dskop,2
	z12 3			;and read in tape subroutine
	dec treqst
	z20 tap+2		;Indirect to disk address
	bru *
!!Page 142
	spb relin,2		;Relinquish disk
	spb treqst,2	;Now rewind 3
	sel 1
	rwd ,3
lcrwd:oct 0			;Flag word
	dld .link.,3	;Set up linkage
	spb insert,2
	sta lclist		;Save entry point
	dld ld3,3		;Date move constant
	mov sdate+1
	lmo			;Reset various indicators
	sta in
	sta perin
	spb time,2		;Get time
	dst ld2,3		;and set in message
	spb messg,2		;Type heading line
	dec ldm
	spb lexec,2		;Exit and wait
	lda lcrwd,3		;wait for rewind to finish
	bze
	bru 2,1
	bcs brw,1
	bru 2,1		;Exit if all not OK
	spb treqst,2	;Read in label
	sel 1
	rtb ltap,3
	    %30
	oct 0
	spb lexec,2		;Exit and wait
	lda *-2,3		;wait for label to come in
	bze
	bru 2,1		;Exit if not
	ldx zero,2		;Prepare to compare labels
labcom:dld ltap,2		;Check label out
	dcb labl,3
	bru lderr
	bru *+2
	bru lderr		;No match
	inx 2,2		;Step pointers
	inx 2,3
	bxl 20,3		;Count
	bru labcom
	ldx 8K,3		;Restore register
	lda ltap1		;Get code word
	bpl
	bru lderr		;all over if plus
	spb mess,2		;Type message
	dec ltap		;type out label
	spb treqst,2	;and read tape
	sel 1
!!Page 143
	rtb lcr1,3		;Read in first record
	    %2050		;Many words...
	oct 0			;Completion indicator
	spb lexec,2		;Exit and return
	lda *-2,3
	bze
	bru 2,1
	dld ldar3,3		;Ready, so get buffer addresses
	dst lcbuf
	ldo
	sta dstkaf		;Inhibit relinquishes



lloopa:dld lcbuf		;Get areas
	xaq			;Switch them
	dst lcbuf		;and save
	lda lcread+2,3	;Get read tape instruction
	ext mask11		;get rid of address
	add lcbuf		;add new address [buffer area]
	sta lcread+2,3
lcread:spb treqst,2	;Now read again
	sel 1
	rtb --,3		;Constructed
	    %2050
lcrdw:oct 0			;Completion indicator
	spb lexec,2
	lda lcrdw,3		;Wait for tape
	bze
	bru 2,1		;Exit if not ready
	srd 2			;Now check for EOF
	bod
	bru lcend		;Crump if so
	sld 1			;Else check for EOT
	bod
	bru lswtch		;Go switch tapes if so
	lda lfila+3,3	;Wait for last disk operation to finish
	bze
	bru 2,1		;not done
	ldx lcbuf,2		;Get address
	lda 0,2		;and pick up code words
	sta lfila+2,3	;and set in parameter list
	lda 1,2		;Get number of words
	sto lfila,3		;and set in file parameter list
	inx 2,2		;Step adress
	lda z2		;Get it
	sta lfila+1,3	;and set in parameter list
	spb dramb,2		;Now use disk
	dec lfila		;and write out previous record
	bru lloopa		;Keep going else

!!Page 144


lswtch:spb messg,2	;Type message
	dec lo7
	spb treqst,2	;Now rewind 3
	sel 1
	rwd ,3
	oct 0			;Flag
	spb lexec,2		;Exit and wait on switch 2
	ldz
	rcs
	sla 2			;Check [console switch] 2
	bno
	bru 2,1		;If not down, exit
	lda sign		;Switch handlers to 7
	ory lcread+3,3
	ory lcend+3,3
	spb treqst,2	;Read label from 7 and beware clods who
	sel 1			;don't rewind tapes
	rtb ltap,7
	    %30
	oct 0
	spb lexec,2		;Exit and wait
	lda *-2,3		;and check completion word
	bze
	bru 2,1		;and exit if not ready
	ldx zero,2		;Set up for label scan
lswcom:dld ltap,2		;Check labels
	dcb labl,3
	bru lderr		;no match
	bru *-2
	bru lderr		;no match
	inx 2,2		;Step pointers
	inx 2,3
	bxl 20,3		;Count
	bru lswcom
	ldx 8K,3		;Restore register
	lda ltap1		;Check key word
	bnz			;had better be zero
	bru lderr		;no, so error
	bru lloopa		;Else get back and keep going



lderr:spb messg,2		;Bad error, abort run
	dec lw

lcend:spb treqst,2	;Rewind 3 - or 7 if that is the case
	sel 1
	rwd ,3
!!Page 145
	oct 0			;Completion indicator
	spb lexec,2		;Exit and wait
	lda *-2,3		;on the indicator
	bze
	bru 2,1		;Exit if not ready
	spb tclos,2		;Just to close up tape
	stx ovtsk,1		;Erase task to link
	ldz
	sta dstakf		;unfudge
	spb relin,2		;Give disk back
	bru icrump		;and crump



lexec:ldx lclist,1	;Get entry point
	stx lcpoin,2	;and save exit
	bru 1,2		;now get right back



link:	ldx lcpoin,2	;Get entry point
	bru 1,2		;and return





.link.:spb link,1		;Entrance linkage
	dec -1
ld3:	dec ld1		;Date move constant
	dec -5
ldar3:dec lcr1		;Buffer areas
	dec lcr2


lfila:z37 32		;Disk parameter list
	dec lcr1+2		;memory address
	oct 0			;Disk address
	oct 1			;Flag word [completion indicator]



	oct 0			;Make sure is odd
	ddc 0
	bss -3
ldm:	oct 377777		;LDM must be odd $$$$$$$$$$$$$$$$$$$$$$$$$
	alf DIS
	alf K L
	alf OAD
!!Page 146
	alf .  
	alf & & & 
ld1:	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & & 
	alf & & T
	alf IME
ld2:	alf & & & 
	alf & & & 
	alf & HO
	alf URS
	oct 373755

labl:	bss 0			;LABL must be even $$$$$$$$$$$$$$$$$$$$$$$
	oct 377777
	alf DAR
	alf TMO
	alf UTH
	alf & CO
	alf LLE
	alf GE 
	alf TIM
	alf E-S
	alf HAR
	alf ING
	alf & SY
	alf STE
	alf M D
	alf ISK 
	alf & DU
	alf MP-
	alf LOA
	alf D T
	alf APE
	alf S.
	oct 606037


lo7:	bss 0			;Put tape 2 on handlr 7.  Toggle 0
	oct 377777		;when ready.
	alf PUT
	alf & TA
	alf PE 
	alf TWO
	alf & ON
	alf & HA
	alf NDL
	alf R 7
	alf . T
!!Page 147
	alf OGG
	alf LE 2
	alf & W
	alf HEN
	alf & RE
	alf ADY
	oct 333755

lw:	alf WRO
	alf NG 
	alf TAP
	oct 253337
	oct 375577

,	*********************************************
,	Do not go above 37500--tape sub. overlay
,	*********************************************



	org ta		;Leave tape some room - temporary storage
lcbuf:bss 2			;Buffer flip-flops
lclist:bss 1		;Entry save
lcpoin:bss 1		;Exit save
	tcd lovwrt

	stl			;Tape operations routine - called by overlays
	ejt
!!Page 148
,	      TREQST is a tape operations routine
,	that may be called from either API or non-
,	APi routines.  Return is immediate, and a flag
,	will be set in the last word of the calling
,	sequence to indicate completion.  Non-API
,	systems using it must do a *SET PBK* before
,	entering and a *SET PST* after control is
,	returned to them
,	      As many as six requests will be
,	stacked up at one time, and the operations
,	will be executed in the order that they are
,	received.
,	TREQB is entered when error correcting is to
,	be left up to the program.


,	Calling sequence...

,	A     spb TREQST,  2
,	A+1   sel x           where x is a plug
,	A+2   zzz yyyy,    H  op, loc, handler
,	A+3       NNNN        number of words
,	A+4   ---             completion indicator


,	      The flag at *A+4* is set to zero upon
,	entrance to the tape routine, and is set non-
,	zero upon completion of an operation.
,	The codes for operation completion are
,	as follows...
,	   1   indicate op successful
,	   2   indicates end-of-tape sensed
,	   4   indicates enf-of-file sensed
,	  20   indicates an error was encountered
,	  40   indicates the request was not
,	       accepted because there were too many
,	       requests stacked up, so try later

,	      Upon sensing an error, the program
,	attempts to correct it seven times.  If the
,	calling program specified that it was to do
,	its own error correcting, then no more action
,	is taken, otherwise a console typewriter
,	message is typed out and action is left up
,	to the operator.


	org pernum
	dec 14
	dec tap

!!Page 149
	org execov
	bss 320		;Save space for other routines

treqst:ldz			;Error correcting to be done internally
	bru *+2

treqb:lda ovflo		;Error correcting to be done by program
	sta terf,3		;Set error flag
treqe:spb tinit,1		;Initialize entrance - else ldx tpoin,1
	inx 1,1		;Step pointer and check
	bxh 6,1		;for wraparound
	ldx 8K,1		;Re-initialize if end of table
	lda ttab,1		;Check next entry
	bnz			;If non-zero, then table full
	bru trful		;too many requests stacked up
	stx tpoin,1		;Save pointer
	sta 4,2		;Reset flag in calling sequence
	stx temp,2		;and get caller
	lda temp
	add terf,3		;add error correcting indicator
	sta ttab,1		;and set in table
	inx 4,2		;Step for return
	lac			;Set timer
	add seven
	sta tlaps,3		;Set timer
	dld .tint.,3	;and get entry
	bru insert		;and insert in task list



tint:	ldx txpoin,2	;Points to entry to be processed
	lda ttab,2		;Check if this is the correct entry
	bmi			;If negative, then error corrector has it
	bru 2,1		;So punt for now
	stx rawt,1		;Save entrance point
	sta z2		;Get pointer to SPB list
	lda 1,2		;Get select instruction
	sta tcw,3
	lda 2,2		;Instruction and memory locations
	sta tcw+1,3
	lda 3,2		;Get handler and length
	sta tcw+2,3
	spb ttest,1		;Test for tape ready
	ldx txpoin,2	;Get pointer again
	lda sign		;Set sign in table for error corrector
	ory ttab,2
	lda seven		;if so, initialize error counter
	sta tcnt
texec:ldx rawt,1		;Get entry
	lda 1,1		;Set error corect entry into list
	sta 0,1
!!Page 150
tcw:	bss 1			;and execute instructions - select
	bss 1			;op and loc
	bss 1			;handler and length
	bru 2,1


tchk:	stx rawt,1		;Save entry
	spt ttest,1		;and check for ready
	oct 2554007		;Yes, check for error [Not 235 inst list]
	bru tercor		;yes, go correct
tccpt:ldx txpoin,1	;Get execution pointer
	lda ttab,1		;and pick up spb location
	sta z3		;and live dangerously [z3 normally has 8K]
	ldz			;free entry
	sta ttab,1
	oct 2554002		;and then for end-of-tape
	add two
	oct 2554001		;Check for end-of-file
	add four
	oct 2554007		;and then if 19 toggled
	add o20		;If so, set bit 15 on
	bze			;Test for all OK
	ldo			;If so, set odd
	sta 4,3		;and set in spb file [list?]
	ldx 8K,3		;Reset register
	inx 1,1		;Step pointer for execution to next entry
	bxh 6,1		;Check for wraparound
	ldx 8K,1		;Yes
	stx txpoin,1	;and save execution pointer
	ldx rawt,1		;Get return
	ldx rawt,2
	set prq		;[request interrupt]
	bru irase		;and erase entry


,	TERCOR attempts to retrieve an error seven
,	times, after which it transfers to TMANY
,	with the tape positioned after the error


tercor:lda tcnt		;Check error counter
	bmi
	bru tmany		;Five [seven?] times
	sbo
	sta tcnt		;Save it
	lda tcw+2,3		;Get handler and number of words
	ext mask11		;and get rid of word count
	sta tcwx+1,3	;and store
	lda tcw+1,3		;Get instruction
	srd 16		;and prepare to convert
	bod			;If odd, then write command
!!Page 151  10/6/02
	dld three		;So pick up bkw instruction
	srd 2
	ado			;flip
	sld 18		;and restore
	sta tcwx,3		;and set in storage
	oct 2540000		;Now execute reverse instructions
tcwx:	oct 0
	oct 0
	lda .terr.,3	;Error entry
tex1:	ldx rawt,1		;Get entry
	sta 0,1		;and set in list
	bru 2,1		;and get back


terr:	stx rawt,		;Save entry
	spb ttest,1		;and check if ready
	bru texec		;Yes, go execute original instructions


ttest:lda tcw,3		;Get select instruction
	sta z2		;and set in register
	lac			;Get clock
	oct 2554000		;Test for ready
	bru ttrdy		;[controller is ready]
	cab tlaps,3		;Check against timer
	bru ttret		;OK
	bru ttret		;OK
	add o40		;No, type message
	sta tlaps,3		;Restore and wait
	spb messg,2		;Type message
	dec tcnr		;Tape not ready
ttret:ldx rawt,1		;Get entrance
	bru 2,1
ttrdy:add seven		;Step [clock]
	sta tlaps,3		;Save
	lda swflg		;Check if billing going on
	bod			;If odd, then on
	bru ttret		;so crump
	bru 1,1		;and get back


,	TMANY checks the error flag set on entry.
,	If bit 1 is on in the table entry corres-
,	ponding to [this thread], the calling
,	program will do its own error correcting.


tmany:ldx tpoin,1		;Get execution pointer
	lda ttab,1		;and table entry
	sla 1			;Check bit 1
	bov
!!Page 152
	bru tccpt		;If on, then accept error and return
	spb messg,2		;Else type message to operator
	dec ttog		;Bad tape error, 2 down to accept then tog 1
	lda .twt.,3		;Switch another entry
	bru tex1		;and get out


,	Switch options after a tape error are
,	  1 down to rewrite the record after the bad
,	    one.
,	  2 down to rety
,	  both up to accept the error
,	then toggle 19
twt:	stx rawt,1		;Error check
	spb ttest,1		;Wait for tape ready
	ldz			;Check switches
	rcs
	bev
	bru ttret		;19 not down so get out
	sla 1
	bov
	bru texec		;Rewrite - but do not reset error count
	sla 1
	bno
	bru tccpt		;Accept
	lda seven		;Else reset error counter and
	sta tcnt
	bru tercor		;Try again

trful:lda sign		;Too many requests stacked up
	sta 4,2		;Reset flag to indicate this
	bru 5,1		;and crump



tinit:lda 8K		;Initialize pointers and entries
	sta tpoin	
	ado			;Fudge for first execution
	sta txpoin
	lda .trqb.,3
	sta kbfdg,3		;Set in billing
	lda .ldx.,3		;Clear for next times
	sta 0,1		;and set in entry point
	bru 0,1		;and get back to it



tclos:lda treqst,3	;ldz
	sta kbfdg,3		;Make billing harmless
	sta kbfdg+4,3
	lda tspb,3		;and set entrance
!!Page 153
	sta treqe,3
	bru 1,2


ttab:	oct 0			;Table stack - 6 entries
	oct 0
	oct 0
	oct 0
	oct 0
	oct 0


terf:bss 1			;Error flag indicator
.tint.:spb tint,1		;Initial entry
	spb tchk,1		;Error-checking entry
.terr.:spb terr,1		;Error correct
.twt.:spb twt,1		;Toggle wait
.trqb.:spb treqb,2	;Entered when billing on
.ldx.:ldx tpoin,1		;Used to initialize
tspb:	spb tinit,2		;used to close out
tlaps:bss 1			;Timing interval

tcnr:	bss 0
	alf TAP		;Tape
	oct 253755


ttog:	bss 0
	oct 376347		;TP 1 DW TO RWR 2 DW TO RTY TOG 19
	alf & 1 
	alf DW 
	alf TO 
	alf RWR
	alf & 2 
	alf DW 
	alf TO 
	alf RTY
	alf & TO
	alf G 1
	oct 113755



	org t			;Temporary storage
tpoin:bss 1			;Stacking pointer
txpoin:bss 1		;Execution pointer
tcnt:	bss 1			;Tape error count
	bss 1			;Spare for re-writing due shortly



!!Page 154
	org k2area		;Moving patch
	dec execov
	dec -192
tapmov:dld *-2
	mov treqst
	bru lovwrt
	tcd tapmov

	stl			;Card to tape
	ejt
!!Page 155

,	Normal call is C/T in which case decimal
,	cards will be written on tape four.

,	If it is desired to use any other options,
,	a handler number must be given immediately
,	after the C/T.  You can stop there or read in
,	binary or full modes.  These are B and F
,	respectively.

,	The program terminates on finding a quote char
,	or hopper empty.  Decimal and full quote cards
,	have 0-7-8 punches in columns 1-6.  Binary
,	quote cards have 0 in 1 and 2 and 0-7-8 in 3-6.
,	The program then writes and EOF.

,	If it is desired to skip to an EOF on the tape,
,	type S at the end of the options.  This will
,	start writing over the EOF.
	org pernum
	dec 16
	dec c/t

	org execov


	dld ctbup,3		;Initialize buffer pointers
	dst ctbp		;in lower memory
	lda ty+1		;Get control word from typewriter
	srd 12		;Get first character
	cab cr		;see if done
	bru *+2
	bru ctsca		;Decimal cards all set up
	sta perin		;Call in new next time
	sta z2
	bhx 7,2		;See if legal tape -- not 7
	bru ctfr1		;Question marks
	inx 8191,2		;Get 8K or almost
	lda cttab+1,2	;Get hander information
	sta ctexe+3,3	;put in instruction
	ldx zero,0		;Counter
ctsc:	bxh 2,0		;See if done
	bru ctsca		;Start cards
	inx 1,0		;Step for next time through
	ldz
	sld 6			;Get character
	cab ctr1,3		;See if binary
	bru cter1		;really illegal
	bru ctb		;binary
	cab ctd1,3		;See if decimal
	bru cter1		;illegal
!!Page 156
	bru ctsc		;decimal all set up
	cab ctf1,3		;See if full
	bru cter1		;illegal
	bru ctf		;full
	cab cr
	bru cter1
	bru ctsca		;Begin - was a carriage return
	cab cts1,3		;See if skip
	bru cter1		;illegal
	bru *+2
	bru cter1
	lda z0		;See if skip last
	sbo
	bze
	bru cter1		;No
	bru ctskip		;So skip

cter1:ldz
	sta bzyf		;Turn off busy flag
	bru ild		;Question marks

ctb:	lda crcb1,3		;Read card in binary
	sto crins1,3	;Set up read insructions
	sto crins2,3
	sto crins3,3
	lda ctd40,3		;Decimal 40
	sto ctexe+3,3	;words to write
	lda cbsyn,3		;Normal binary synch
	sta cnsyn,3		;Fill in syncword check
	lda cbq1,3		;Quote card
	sta crok,3		;branch for quote card check
	lda cbsynp,3	;Get location of syncword
	sta csync,3		;and store it in the check area
	sta csync2,3
	bru ctsc		;and see if have an 'S'

ctf:	lda crcf1,3		;Read card full
	sto crins1,3	;Set up read insructions
	sto crins2,3
	sto crins3,3
	lda ctd80,3		;Decimal 80
	sto ctexe+3,3	;words to write
	lda cfsyn,3		;Full sync
	sta cnsyn,3		;Fill in synchword check
	lda cfq1,3		;Quote card
	sta crok,3		;branch for quote card check
	lda cfsynp,3	;Get location of full syncword
	sta csync,3		;and store it in the check area
	sta csync2,3
	bru ctsc		;and see if have an 'S'

!!Page 157
ctsca:bss 0			;Start everything here
	dld .ctst.,3	;Get entrance
	spb insert,2	;and put in task list
	sta ovtsk		;Save pointer
	sta z1
ctsca1:spb ctext,2		;[Save exit and return]
	bcn			;First wait for reader
	bru 2,1
	ldx ctbp+1,1	;Get first buffer
crins1:rcd 0,1		;First card read instruction
	hcr
,	Instructions now set up
ctcr:	spb cread,2		;Read a card and check last sync word
	spb ctext,2		;Set up exit
	lda ctexw,3		;See if tape write completed
	bze
	bru 2,1		;No, so wait some more
ctexe:spb treqst,2	;Tape subroutine
	sel 1
	wtb 0,4
	    %27
ctexw:oct 1			;Flag
	bru ctcr		;and get another card

,	CREAD reads a card in proper mode, checks
,	syncword and quote, and then flips buffer
,	addresses.

cread:stx cren,2		;Save entrance
cread1:lac
	add four		;Increment time for check
	sta ctime
	spb ctext,2		;Set up exit
	ldx ctbp+1,2
	bcn
	bru crhop		;Check hopper empty condition
	ldx ctbp,1		;Get buffer pointer in index register
crins2:rcd 0,1		;Read the card
	hcr
csync:lda 27,2		;Get last syncword
	cab cnsyn,3		;Normal syn
	bru *+2		;Error message
	bru crok		;OK
	spb messg,2
	dec crerm2		;Card reader error backspace 2 and toggle 1
	spb ctext,2
	ldz			;Wait for toggle
	rcs
	sla 1
	bno
	bru 2,1		;Not yet
!!Page 158
	spb ctext,2		;1 down
	ldz			;[I think wait for sw 1 up again]
	rcs
	sla 1
	bov
	bru 2,1
	ldx ctbp+1,2	;Prime buffer again
crins3:rcd 0,2
	hcr
	bru cread1		;and read again
,	Card read was OK - change buffers and get out

crok:	bss 0			;Check for quote - filled in with a bru
	bru cdq		;Normal is decimal
crok1:dld ctbp
	xaq
	dst ctbp
	sto ctexe+2,3	;Store address in write instruction
	ldx cren,2		;Get entrance
	bru 1,2		;and return
,	Check for hopper empty
crhop:lac
	cab ctime		;See if it should be ready
	bru 2,1		;OK
	bru 2,1		;OK
csync2:lda 27,2		;Check last syncword
	sla 1
	bov
	bru ctter		;Terminal [exit] - write EOF and get out
	spb messg,2
	dec cterm3
	lac
	add cr		;Increment wait time
	sta ctime
	bru 2,1		;and get out
,	Binary quote check
cbq:	lda 0,2		;[First quote word]
	bnz
	bru crok1		;OK, go on
	lda 1,2
	sub cbqu1,3		;Second quote word
	bnz
	bru crok1		;OK
	lda 2,2		;Third word
	sub cbqu1,3
	bnz
	bru crok+1		;Go on
	bru ctter		;Quote card - terminal exit
cbqu1:oct 2015006		;Binary quote
,	Decimal quote
cdq:	dld 0,2
!!Page 159
	dcb cdqu1,3
	bru crok1		;OK - process
	bru ctter
	bru crok1
cdqu1:oct 777777
	oct 777777
,	Full quote
cfq:	ldx zero,0
cfql:	dld 0,2
	dcb cfqu1,3
	bru crok1
	bru *+2		;First matches
	bru crok1
	bxh 2,0		;Check for done
	bru ctter		;Quote found
	inx 1,0		;Step
	inx 2,2
	bru cfql		;and try again
cfqu1:oct 1006		;Full quote
	oct 1006

,	Read till end-of-file, backspace, and start
ctskip:dld .ctst.,3	;Put task in list
	spb insert,2
	sta ovtsk		;Save where it is
	lda ctexe+3,3	;Get handler
	sta ctskh+1,3
	ext mask11		;77777
	sta ctsk1+1,3
ctskn:spb treqst,2
	sel 1
ctskh:rtb io1,4
	    %27
	oct 0
	spb ctext,2
	lda *-2,3
	bze			;If [completion] flag zero, get out
	bru 2,1
	sra 2			;Check for EOF
	bev
	bru ctskn		;not yet
	spb treqst,2
	sel 1
ctsk1:bkw ,4		;Backspace
	oct 0
	spb ctext,2
	lda *-2,3
	bze
	bru 2,1		;Get out
	bru ctsca1		;Start at beginning - almost
!!Page 160

ctext:stx ctpoi2,2
	ldx ovtsk,1
	bru 1,2
,	Write end-of-file.  If from batch, return to
,	it.  If not, reset flags and exit to task list

ctter:lda ctexe+3,3	;Get handler
	ext mask11		;77777
	sta ctter1+3,3	;[EOF write instruction]
	sta ctter2+3,3	;[Rewind instruction]
ctter1:spb treqst,2	;Tape op
	sel 1
	wef ,4
	oct 0			;Flag
ctter2:spb treqst,2
	sel 1			;Rewind now
	rwd ,4
	oct 0
	spb ctext,2
	lda *-2,3
	bze
	bru 2,1
	bcs brw,1
	bru 2,1		;[Wait for both tape operations to complete]
	lda cmessb		;See if batch in
	bze
	bru iredy		;No
	ldx zero,2		;Get batch
	inx batch,2
	lmo
	sta io1		;Front in
	bru pgetb		;Get batch

,	Normal entrance is here
ctst:	ldz			;Check for zero down
	rcs
	bmi
	bru 2,1		;Yes, get out
	ldx ctpoi2,2	;Get entrance to routine
	bru 1,2		;and go there


,	Table of syncwords and places
cnsyn:oct 2606077		;Normal decimal sync
cbsyn:oct 2001777		;Binary
cfsyn:oct 2007777		;Full
cbsynp:lda 41,2		;Location of binary syncword after read
cfsynp:lda 83,2		;Location of full sync after read
!!Page 161

,	Tape handler table

cttab:bss 0
	z21 27		;[0]
	z02 27		;[1]
	z04 27		;[2]
	z10 27		;[3]
	z21 27		;[4]
	z22 27		;[5]
	z24 27		;[6]
	z21 27		;[7]Make 0 to 4

.ctst.:spb ctst,1
	dec -1

ctbup:dec io1		;Buffer pointers
	dec io2

,	Card reader trouble
cterm3:oct 372321
	alf RD 
	alf REA
	alf DER
	alf & TR
	alf OUB
	alf LE.
	oct 375577

,	Card reader error backspace 2 and toggle 1

crerm2:oct 372321
	alf RD 
	alf REA
	alf DER
	alf & ER
	alf ROR
	alf & BA
	alf CKS
	alf PAC
	alf E 2
	alf & AN
	alf D T
	alf OGG
	alf LE 
	oct 13755
crcb1:rcb 0
crcf1:rcf 0
ctd40:dec 40
ctd80:dec 80
cbq1:	bru cbq
!!Page 162
cfq1:	bru cfq
ctb1:	alf 00B		;[These 4 characters must be in alpha order]
ctd1:	alf 00D
ctf1:	alf 00F
cts1:	alf 00S

,	Lower memory
	org ta
ctbp:	bss 2
ctpoi2:bss 1		;Master return
cren:	bss 1
ctime:bss 1

	loc 6000		;Put tape subroutine on the end of this
ctfix:lda tap+2		;Disk address of subroutine
	sta *+5
	bcs brn,0
	bru *-1
ctfix1:sel 0
	prf ,0
	oct 0
	bcs brn,0
	bru *-1
	sel 0
	rrd 3,0
	    %treqst
	bcs brn,0
	bru *-1
	bcs ber,0
	bru ctfix1

	bru lovwrt		;Now go and load

	tcd ctfix

	stl			;System loader
	ejt
!!Page 163

,	The system loader will load a time-sharing-
,	compatible system from the card reader.
,	Transfer to the end card on index register
,	2 and index group zero, and expect a return
,	to 1,2.  The loader will then write the
,	system on the disk and read in the next
,	card.  It terminates on a hopper-empty
,	condition.  It also checks for cards
,	loaded into illegal addresses, namely all
,	those not in between 1400 and 33777.   It
,	works while time-sharing is running by
,	asking the D-30 to start a batch run.  This
,	prevents wiping people out.

,	After an overlay has been loaded, the loader
,	expects to find the length of the overlay,
,	raised to the next highest multiple of 64
,	words in the A register.


	org pernum
	dec 18
	dec sys		;SYStem

	org execov
	lda o10
	spb spmess,2	;Start batch
	bru 2,1		;return to exec
	lda three		;Ask for clock off
	spb spmess,2
	lda kermes		;Error message
	sta mbx0		;will crump batch
	dld .sin.,3		;Insert task
	spb insert,2
	sta ovtsk		;and save where
	spb messg,2		;Acknowledge message
	dec pcr
	lda 8K		;and initialize
	sta spoin		;task pointer
	sta io1+41		;Synchword
	sta in		;Reset system indicator
	sta perin		;Knock out overlay-in-memory indicator
	lac			;and set interval
	add seven
	sta slapse
	lda swdct1,3	;Word count mask
	sta swdct
	lda saddr1,3	;Address mask
	sta saddr
	lda soctct1,3	;One bits for octal correction module
!!Page 164
	sta soctc
	lda sign		;Construct mask
	sra 5
	sta smask		;3760000
	lda wait1		;Upper bound check
	sta pct		;set return to wait loop
	sta slim
	ldz			;Clear memory
	sta io2+40
	sta sx3sv
	rcs			;to contents of switches
	bod
	bru sinx		;[but not if 19 down?]
	sta sl1
	dld sl2,3
	mov sl1
sinx:	lda .sin1.
	sto spoin
	set prq		;Set prq to get started
	bru slret		;and wait in loop

sin1:	spb srchk,2		;Check reader
	rcb io1		;Read first card
	hcr			;and crump the silly thing
	lda .swn.		;Set pointer
	sto spoin
	bru slret		;and get out



swn:	spb srchk,2		;Set pointer for main routine
	lda .sld.
	sto spoin
	dld io1		;and check card
	dsu .swon1,3	;Check if first card is system loader
	bze
	xaq
	bnz			;If not, process it
	bru sld
	dld io1+2		;Else check next word
	dsu .swon2,3
	bze
	xaq
	bnz			;If unequal, process
	bru sld
	rcb io1		;If matches, crump this card
	hcr
	bru slret		;and get out



!!Page 165  10/7/02
sin:	ldz			;All entries begin her
	rcs			;Check switch 0
	bmi			;If down, crump
	bru 2,1
	ldx spoin,2		
	bru *+1,2
	bru sld		;[Main routine]
	bru sror		;Checksum error
	bru sdsk		;Write system on disk
	bru 2,1		;Return and do nothing
	bru 2,1		;Not used now
	bru 2,1		;Not used now
	bru sin1		;and initial sequence
	bru swn		;First card check
.sld.:equ zero
.sror.:equ one
.sdsk.:equ two
.styp.:equ three
.sin1.:equ six
.swn.:equ seven



srchk:bcn			;Check reader
	bru schk		;not ready
	lac			;Set timer
	add seven
	sta slapse
	bru 1,2		;and get back

schk:	lda io1+41		;Check syncword for hopper empty
	sub .schk,3
	bze			;If empty, completely done
	bru syend
!!***************************************************
!!JSM: ERROR?: The instruction below was originally
!!    bru 2,1
!!which has the effect of making the coding beginning
!!immediately afterwards (starting with 'lac')
!!unreachable.  The unreachable code checks a
!!countdown timer on the card reader and types an error
!!message if it remains "not ready" when the countdown
!!expires.  This behavior is inconsistent with other
!!peripheral- (and specifically card reader-) handling
!!code, and I think it was an updating error--that is,
!!the bru 2,1 was intended for somewhere else.
!!I replace the original instruction with a 'nop',
!!as shown below.
!!***************************************************
	nop			;jsm *****ERROR was bru 2,1
	lac			;Else check time
	cab slapse
	bru slret
	bru slret		;Crump
	add cr		;and set it up if over
	sta slapse
	spb messg,2
	dec scrn		;Card reader not ready
	bru slret



sld:	spb srchk,2		;This is the main routine - check reader
	dld sr2,3
	mov io1		;Move card image into working area
	sta z1		;Initialize word pointer
!!Page 166
	sta sdiskf		;Blank flag
	lda io2,1		;Begins in lower bank... get first word
	bze			;Octal corrections module
	bru soct
	ldx sx3sv,3		;Keep same bank as before
	ext swdct		;Mask off all but word count
	bze			;If none, transfer card
	bru stran
	rcb io1		;and get next card
	hcr

snext:sra 13		;Get word count right-justified
	sta z0		;and set in counter
	lda io2,1		;Get word again
	ext saddr		;and get address
	bmi			;If negative, Dartmouth-style card
sdart2:bru sdart1		;Change loader to take Dar cards
	sto z3		;Else set in register and leave bank
	lda z3		;Check if too low
	ext smask
	cab mendt
	bru serad		;Crump
	bru *+1		;OK
smore:inx 1,1		;Increment working area pointer
	lda z3		;Check where storing for too far up
	ext smask
	cab slim
	bru *+3		;OK
	bru serad		;Crump
	bru serad
	lda io2,1		;Get next word
	sta 0,3		;and put away
	add io2-1,1		;Checksum
	bov			;If overflow, step by one
	ado
	sta io2,1		;and save across card
	inx -1,0		;Decrement counter
	inx 1,3		;Step address counter
	bxh 1,0		;and check if end of block
	bru smore		;No, get some more words
	sub io2+1,1		;See if checkword OK
	bnz			;Checksum error
	bru ser1
	inx 2,1		;Get next origin
	lda io2,1
	ext swdct		;and leave word count
	bnz			;If words, get them
	bru snext
	stx sx3sv,3


!!Page 167

slret:ldx 8K,3		;Reset register
	ldx ovtsk,1		;Get return
	bru 2,1		;and get out



soct:	rcb io1		;Octal corrections module
	hcr
	bru socte		;and begin scanning

soctb:sra 10		;Get left half
	ext soctc		;and mask off sign and high-order end
	nor 16
	sla 1			;Check for word
	lda socacc		;Get accumulated word so far
	bov			;overflow if word
	bru soctd
	bxl 2,3		;Nothing so far, keep scanning
	bru socte
	bxl 3,3		;Terminate on single character field
	bru slret
	bxh 7,3		;6 or 7 character is instruction
	bru soctf
	sta socadd		;Else address

socte:dld zero		;Zero out A, Q, and register 3
	sta z3
	bru socta-1		;and check card

soctd:sld 3			;Accumlate characters
	ext 0
	bno
	chs
	sta socacc		;and save
socta:inx 1,3		;Step character count immediately
	bxh 40,1		;and check if end of card
	bru slret
	lda soctc
	lqa			;Put some one bits in Q
	lda io2,1		;Get word
	bxl 1,2		;Check if end  of word
	spb soctb,2		;No, get first half
	inx 1,1		;Else get next word
	ldx zero,2		;and reset flag
	bru soctb+1

soctf:ldx socadd,3	;Get address counter
	sta 0,3		;and put away word
	inx 1,3		;Bump up counter
	stx socadd,3	;and save
!!Page 168
	bru socte		;and get some more



sdart1:ldx 8K,3		;Reset register
	lda sdart,3		;Change instructions
	sta sdart2,3	;to assume all rest will be Dartmouth-style
	sta sdart3,3
	lda socte+1,3
	sta sdart2+1,3
	sta sdart3+1,3
	bru snext+2,3	;Get back



stran:lda io2,1		;Transfer card
	bmi			;If negative, Dartmouth upper memory
sdart3:ldx 8K,3		;If first of kind, transfer correctly
	sto z3		;else stay in bank
	lda z3		;Save location
	sta xr03
	lmo			;Reset flag for correct exit
	sta sdiskf
	sxg 0			;Set group zero for system
	set pst		;and prepare to exit API
	set pbk		;with no interrupts
	ldx 8K,3		;Restore register
	bru *+2,3
	bru 0,3		;Transfer
	spb *-1,2		;Save return for systems
	rcb io1		;Now get next card - as well as generate
	hcr			;interrupt on 225
	ldx z3,3		;[API register 3 to current register 3]
	sta sleng		;Length of overlay
	sra 6
	sto sdksb+1,3	;Number of records for operation
	lda sname+1,3	;See if overlay
	bnz
	bru *+3
	lda so140,3		;System to put 96 records back
	sto sdskb+1,3
	lda .sdsk.		;Return is to here
	sto spoin		;and set pointer
	set pst
	set prq		;Set prq
	bru wait



ser1:	ldx 8K,3		;Set up register
	lda .sror.
!!Page 169
	sto spoin		;and set pointer
	spb messg,2	
	dec schksm		;Checksum error - backspace two cards
sror:	ldz			;toggle 2 when ready.
	rcs			;Check 2
	sla 2
	bno			;Not down, crump
	bru slret
	spb srchk,2
	rcb io1		;OK
	hcr
	lda .sld.
	sto spoin		;and set it to load
	bru slret



serad:stx sx3sv,3		;Address out of bounds
	ldx 8K,3		;Restore register
	spb messg,2		;and type message
	dec silad
	bru slret		;and get next card



sdsk:	ldx zero,2		;Set register for search
	lda sname,3		;Get name
sdsk1:cab sytab,2		;Search address table
	bru *+2
	bru sfnd		;Found
	inx 1,2		;and step pointer
	bxl last,2		;Check end of table
	bru sdsk1		;OK
	sta ssno1,3
	spb messg,2
	dec ssno		;System not available
	bru icrump


sfnd:	lda .styp.		;Set up to do nothing while writing on disk
	sto spoin		;and set in pointer
	lda sname+1,3	;Get replacement or overlay number
	sto sylo2,3		;set in overlay message
	sto *+1,3		;and set for step to get address
	inx 0,2		;Step pointer by identifying number
	lda sytab+1,2	;Get correct disk address
	sta sdksb+3,3	;Set in parameter list
	lda sname,3		;Get system name again
	ldx 8K,2		;and initialize for search
sfnd1:cab snames,2	;Check against list of system names
	bru *+2		;Not found
!!Page 170
	bru *+3		;Found OK
	inx 3,2		;Keep searching
	bru sfnd1		;and try again
	sta syl1,3		;Get names and set in typewriter message
	lda snams+1,2	;Second word
	sta syl1+1,3
	lda snams+2,3	;Third word
	sta syl1+2,3
	spb messg,2		;Output system name
	dec syl		;System
	lda sname+1,3	;Get identifying number and see if overlay
	bze			;If zero, then system
	bru sfnd2		;so punt
	spb messg,2		;Else type overlay number
	dec sylo
	lda sleng		;See if overlay fits in space
	sra 5			;Position for disk command
	sub two		;translate to zero
	add sdskb+3,3	;Disk address
	ext mask1		;3777400
	sub o300
	bpl
	bru sler
sfnd2:spb dskb,2		;Ask for disk

sdksb:spb dskop,2		;and write system on disk
	z37 96		;write, 96 records
	dec system		;from system location
	z00 --		;constructed disk address
	bru sterm		;Error - crump works
	spb relin,2		;Relinquish disk
sdskb2:lda .sld.
	sto spoin
	ldz			;Reset lower bank
	sta sx3sv
	bru sld		;Process


sler:	spb messg,2
	dec stlo		;Overlay too long
	bru sdskb2		;Continue


sterm:spb messg,2		;Type no-load message and crump as disk error
	dec snol		;No load
	bru icrump		;and punt



syend:lda sdiskf		;Check for silly clods who leave off
	bmi			;extra blank
!!Page 171  10/9/02
	bru icrump		;OK
	spb messg,2		;Else type message
	dec sblank
	ldx ovtsk,1
	spb irase,2		;and delete entry
	lda four		;Ask for count
	spb spmess,2
	bru iresp		;and reset pointers



snams:alf BAS		;BASIC
	oct 313277
	oct 777777
	alf ALG		;ALGOL
	oct 464377
	oct 777777
	alf XBA		;XBASIC
	alf SIC
	oct 777777
	alf XAL		;XALGOL
	alf GOL
	oct 777777
	alf FOR		;FORTRAN
	alf TRA
	oct 457777
	alf XFO		;XFORTRAN
	alf RTR
	oct 214577
	alf DIP		;Dartmouth Interpretive Program
	alf & & & 
	alf & & & 
	alf TSA		;Time-Sharing Assembly Processor
	alf P
	alf & & & 
	alf EDI		;EDIT system
	alf T
	alf & & & 



.sin.:spb sin,1		;Entry
	dec -1
sl2:	dec sl3
	dec -13566
sr2:	dec io2
	dec -40
.swon1:ldo			;First four words of system loader card
	sta pmbx0
.swon2:bcs brn,0
	bru 2
!!Page 172
saddr1:oct 1760000	;Leave address
swdct1:oct 2017777	;Leave word count
soctc1:oct 3776000	;Upper end mask
so140:oct 140		;96 records
sdart:add 8K		;Instruction change for Dartmouth cards
.schk:oct 3001777		;Hopper empty check
sl1:	eqo 1400
sl3:	eqo sl1+1




syl:	bss 0			;System
	oct 373737
syl1:	alf & & & 
	alf & & & 
	alf & & & 
	oct 375577

sylo:	bss 0			;Overlay #
	alf OVE
	alf RLA
	oct 707777
	oct 601360
sylo2:alf & & & 
	oct 375577

scrn:	bss 0			;Card reader not ready
	oct 372321
	alf RD 
	alf REA
	alf DER
	alf & NO
	alf T R
	alf EAD
	oct 703337
	oct 557777

schksm:bss 0		;Checksum error, backspace two cards and
	oct 372330		;toggle 2 when ready
	alf ECK
	alf SUM
	alf & ER
	alf ROR
	alf , B
	alf ACK
	alf SPA
	alf CE 
	alf 2 C
	alf ARD
	alf S A
!! Page 173
	alf ND 
	alf TOG
	alf GLE
	alf & 2 
	alf WHE
	alf N R
	alf EAD
	oct 703337
	oct 557777

silad:bss 0			;Address out of bounds
	oct 372124
	alf DRE
	alf SS 
	alf OUT
	alf & OF
	alf & BO
	alf UND
	oct 623337
	oct 557777

ssno:	bss 0			;System not available
	oct 376270
	alf STE
	alf M N
	alf OT 
	alf AVA
	alf ILA
	alf BLE
	oct 777760
ssno1:alf & & & 
	oct 333755

snol:	bss 0			;No load.
	oct 374546
	alf & LO
	alf AD.
	oct 375577

sblank:bss 0		;*** Missing blank ***
	oct 373754
	alf ***
	alf & MI
	alf SSI
	alf NG 
	alf BLA
	alf NK 
	alf ***
	oct 543755

stlo:	bss 0			;Overlay too long
!!Page 174
	oct 374665
	alf ERL
	alf AY 
	alf TOO
	alf & LO
	alf NG
	oct 375577




	org t			;Temporary storage
spoin:bss 1			;Routine pointer
slapse:bss 1		;Elapsed time counter for card reader
sx3sv:bss 1			;Register 3 save
swdct:bss 1			;Word count mask
saddr:bss 1			;Address mask
soctc:bss 1			;High-order mask
soctacc:bss 1		;Word accumulator
soctadd:bss 1		;Address
slim:	bss 1			;Upper limit
smask:bss 1			;Mask for all high-order bits above 16K
sdiskf:bss 1		;Disk flag for missing blanks
sleng:bss 1			;Overlay length
	tcd lovwrt		;end

	stl			;Debugging package - DBGOUT, DBGOCT, DBGCOM
	ejt
!!Page 175
,	These debugging routines are called from
,	the console typewriter.
,	The commands are...
,	   *DBGOUT* to dump on the printer with HSMP
,	   *DBGOCT* to use the octal insert routine
,	   *DBGCOM* to get a communications dump


,	CHAR is a character pickup routine that
,	takes characters from ty and places them one
,	at a time in the A register.


,	OUT takes parameters inputted from the
,	console typewriter and will dump from the
,	specified locations onto the high speed
,	printer.
,	The format is as follows
,	OUT xxxxx,xxxxxx$  where $ stands for
,	a carriage return.  Embedded blanks and
,	other non-numeric characters are ignored.  The
,	dump will be from the location before the
,	comma to the location after.  OUT, will
,	dump from 0, but the other parameter must
,	be there.


,	OCTAL takes the input before a colon and sets
,	it in the location counter.  A comma causes
,	the previous input to be stored in the
,	address of the counter, and increments it by
,	one.  [The format is...]
,	OCTAAAAA,XXXXXXX,YYYYYYY, etc.
,	OCTAL without an address will save the pre-
,	viously used one - zero if not initialized
,	WARNING...8, 9 are treated as zero


,	DUMP is a modified version of GE's high-
,	speed printer memory dump.  The dump
,	is entered with from and to adresses in
,	A and Q.  It uses two separate buffer areas
,	for printing from.




	org pernum
	dec 20
	dec dbg

!!Page 176
	org execov
	spb bgtoff		;Ask time stop
	lda sloc1,3		;Get accumulated counter so far
	sta sloc
	lda com3,3		;Set up test registers
	sta com1
	lda col3,3
	sta col1
	dld dumpmb,3	;Setup some more constants for HSMP
	dst dmpmsk
	lda ty+1		;Check if OUT or OCTAL
	cab comnic,3	;Communications debugging
	bru sdel		;No, error
	bru combug		;Debug communications system
	cab oct,3		;OCTAL
	bru sdel		;No
	bru octal
	cab out,3		;HSMP dump
	bru sdel		;No
	bru HSMP
	cab bgtim,3		;Check for clock-set
	bru sdel		;No
	bru bgtime
	bru sdel		;Not found at all, error

char:	bxl 2,2		;2 must be initialized at plus two
	bru char23
	ldx zero,2
char2:inx 1,1		;and increment one
	lda ty,1		;Get word
	sta ch3		;and break up
	sra 6
	sta ch2
	sra 6
char1:ext mask7		;Get rid of all but character
	bru 1,3		;Exit
char23:lda ch2,2		;Get next character
	inx 1,2		;and increment pointer
	bru char1



hsmp:	dld zero
	sta temp		;and temporary storage
	dst z0
	sta z2
	sta rawt
	spb char2,3		;and get character
	cab com1		;Check for comma
	bru *+2		;No
	bru ocom		;Yes
!!Page 177
	cab cr		;and check for carriage return
	bru *+2
	bru ocr		;Yes
common:cab seven		;Check if less than 7.
	bru *+3		;OK
	bru *+2
	bru char		;Ignore and get another
	bxh 7,0		;Check if more than 7
	bru sdel
	inx 1,0		;Increment counter
	srd 3
	add temp		;Save character and build word
	sld 3
	bov			;If overflow, sign bit set
	add sign
	sta temp		;Save word
	bru char		;and get out


ocom:	lmo			;Reset flag
	sta rawt
	lda temp		;Get word
	sta dumpbg
ocomon:ldz			;Reset counters and storage
	sta temp
	sta z0
	bru char

ocr:	lda rawt		;If no comma yet, crump
	bpl
	bru sdel
	lda temp		;Get to location
	lqa
	lda dumpbg		;and from in A
	ldx 8k,3
	spb dump,1
	bru oct3		;Get out



octal:dld zero		;Initialize registers
	sta temp
	dst z0
	sta z2
	spc char2,3		;Get character
	cab col1		;Check for colon
	bru *+2
	bru scolon		;Found
	cab com1		;Check for comma
	bru *+2
	bru scomma		;Found
!!Page 178
	cab cr		;and carriage return
	bru common
	bru scr
	bru common

scolon:lda temp		;Get location
	sta sloc		;Set in counter
	bru ocomon		;and reset storage

scomma:stx rawt,2		;Save register
	stx dtmp,3		;Save register 3
	spb scom1,2
	ldx rawt,2
	ldx dtmp,3		;Restore 3
	bru char		;and get another character
scom1:ldx sloc,3		;Get location
	lda temp		;and store word there
	sta 0,3
	inx 1,3		;Bump up address counter
	stx sloc,3		;and save
	ldz			;Reset
	sta temp
	sta z0
	bru 1,2

scr:	spb scom1,2		;Act as if comma
	ldx 8K,3
	lda sloc		;Restore location counter
	sta sloc1,3
oct3:	bru icrump		;and get out

sdel:	ldx 8K,3		;Restore register
	spb messg,2		;Illegal task
	dec del
	bru oct3		;and crump



,	COMBUG is used to debug communications by
,	patching out certain selected locations in
,	the main body of the executive.  In place
,	of the original instructions, which it saves,
,	it places branches to printout routines,
,	which dump the lower-lower storage area,
,	and the inserted tasks in iplst.



combug:bss 0
	lda cbuga,3		;The routine is terminated by stop.
	sta cbugas,3
!!Page 179
	lda cbugb,3		;Exit patch
	sta cbugbs,3
	lda icrump,3	;Crump location
	sta cbugcs,3
	lda .coma.,3	;and set in mailbox receipt routine
	sta cbuga,3
	lda .comb.,3	;Get exit patch
	sta cbugb,3
	lda .comc.,3	;and patch out crump
	sta icrump,3
	sta perin		;Destroy system-in indicator
	spb messg,2		;Type ready
	dec rea
	spb bgton,2		;and ask for ON
	bru 2,1		;and get back


coma:	stx dtmp,2		;Entry from mailbox
	spb bgtoff,2	;Ask for OFF
	bcs bpn,6		;and slew to top of page so we can
	bru *-1		;see what we're doing
	sel 6
	slt 8
	dld obug1,3		;Get first set of locaitons
	spb dump,1		;and dump
	dld obug2,3		;Dump save area
	spb dump,1
	dld obug3,3		;iprior-iplst
	spb dump,1
	bcs bpn,6		;and slew extra four lines in between
	bru *-1
	sel 6
	slw 4
	spb bgton,2		;Ask for ON again
	ldx dtmp,2		;and return
	bru cbuga+1,2	;and branch to list


comb:	sta dtmp		;Exit-debugging dump
	spb bgtoff,2	;Ask for OFF
	dld obug3,3		;Third set
	spb dump,1
	dld obug2,3		;Second set
	spb dump,1		;and dump
	dld obug1,3		;First set
	spb dump,1		;and dump
	spb bgton,2		;Ask for ON
	lda dtmp		;Get answer again
	sta mbx0		;and set in mailbox
!!Page 180
	bru cbugb+1		;and get back


comc:	lda cbugas,3	;Restore debugging entries
	sta cbuga,3
	lda cbugps,3	;Restore second patch
	sta cbugb,3
	lda cbugcs,3	;Icrump restore
	sta icrump,2
	bru icrump		;and get back



bgtoff:lda three		;Ask for time count stop
	bru spmess

bgton:lda four		;Ask for time count resumption
	bru spmess


,	BGTIME converts a time entered in hours and
,	minutes to octal 6ths of a second for the
,	real-time clock.  The call is DBGTIM
,	followed by the hours, then a colon, then the
,	minutes.  [A final $ is required for the time
,	to take effect.]

bgtime:dld zero		;Initialize some areas
	dst z0
	sta z2
	sta temp		;and temporary storage
	sta rawt
	spb char2,3		;and then get characters
	cab col1		;Check for colon
	bru *+2		;No
	bru bgcol		;Yes, go process
	cab cr		;Check for carriage return
	bru *+2		;No
	bru bgcr		;Else go process
	cab ten		;Check for digits
	bru bgcon		;Yes, convert them
	bru char		;Else continue scan
	bru char


bgcon:bxh 2,0		;Check if over two characters
	bru sdel		;If so, crump
	mpy ten		;Else convert to binary
	inx 1,0		;and step counter
	bru char		;and get next character

!!Page 181
bgcol:ldz			;Colon
	mpy h1		;Get hours in sixths of a second
	bnz			;Check for too many
	bru sdel		;If so, crump
	laq			;Else get them
	sta dumpx		;and save them
	lda rawt		;Check if second time or fudge carriate ret
	bod
	bru bgdon		;Two colons will also do
	lda two		;Colons will reset if more than one
	sta rawt
	dld zero		;Re-initialize
	sta z0		;and reset counter
	bru char		;and get some more characters


bgcr:	lda rawt		;Check if colon previously
	bnz			;Yes, OK
	bru *+4
	ldo			;Else pretend colon
	sta rawt
	bru bgcol		;and go process hours
	ldz			;Get minutes in sixths of a second
	mpy h2
	laq
	add dumpx		;add hours

bgdon:ldx 8K,3
	bmi			;Check if too large by far
	bru sdel
	cab bgmax,3		;and check if over 24 hours
	bru *+3		;No, OK
	bru *+2		;Still OK
	bru sdel		;Dummy...
	sta dumpx		;Save for later
	spb bgton,2		;ask for time count
	dld .bgst.,3	;Get entry for table
	spb inset,2
	sta ovtsk		;and make crumpable
	spb messg,2		;Type message
	dec rea
	bru irest		;and get back


bgst:	lda pct		;Check for TON
	bpl
	bru 2,1		;If so, get out
	sna 19		;Else get character
	sub bgkey,3		;[Check if $]
	bnz			;If not, keep trying
	bru 2,1
!!Page 182
	lda dumpx		;Else get time
	lca			;and set in C register
	add four		;Set various timers according to new clock
	sta int1
	add three
	sta dival
	sta hdskd
	add h2
	bmi			;Check too large
	bru *+4
	cab bgmax,3		;Check for too close to midnight
	bru *+3		;OK
	bru *+1		;[too] close
	lda bgmax,3		;Too close
	sta itim
	add k3loc
	bmi
	bru *+4		;Too large
	cab bgmax,3		;Check for close to midnight
	bru *+3		;OK
	bru *+1		;[too] close
	lda bgmax,3
	sta .eff
	spb time,2		;and type out new time
	dst bgnew1,3
	spb messg,2		;and type message
	dec bgnew
	spb irase,2		;and erase task
	ldz			;Zero out flags
	sta ovtsk
	sta bzyf		;and busy flag
	bru irest		;and crump





dump:	stx dumpx1,1	;Save return
	ext seven		;From A to Q
	sta dumpbg		;Save starting address
	bcs bpn,6		;Wait for printer ready
	bru *-1
	sel 6
	slw 4			;Slew page 4 lines
	laq			;Get ending address
	ext seven		;Mask out low order end
	sta dumped
	dld dumpbk,3	;Get buffer addresses
	dst dumpio		;and set in flip flops
	sto dump1x+1,3	;as well as a couple of other places
!! Page 183
	sto dump04,3
	sta z3
	ldx 8K,2		;Set register
	lda dumpbl		;Get blanks
	sta 0,3
	sta 40,3		;Buffer areas differ by 40
	inx 1,3		;Increment area
	inx 1,2		;Count
	bxl 35,2		;and test
	bru *-5		;No
	add sign		;Make last entries negative blanks
	sta 0,3
	sta 40,3
	ldx 8K,2		;Initialize registers
	ldx dumpbg,3
	bru dumpad

dumpov:stx dumpx,3
	lda dumpx
	sub dumped		;Test for end dump
	bpl			;If finished dumping, get out
	bru dumpex
	lda 0,3		;Repetitive
	sub 8,3		; edit by lines
	bnz			;Not alike
	bru dumpit
	inx 1,3		;Test next
	bru dumpov

dumpwb:lda 0,3		;Get word
	srd 18		;Position for build
	ext dmpmsk		;oct 3777774 - mask out high-order bits
	add dmpbbz		; with leading blanks
dump1x:ext sign		;Insure plus
	sta 0,2		; in image [modified instruction]
	inx 1,2		;Count
	bru 1,1		;Return
dumpbd:sla 3		;Build
	sld 3			; 3
	sla 3			; characters
	sld 3			; in
dumpa1:sla 3		; A reg.
	sld 3			; from Q reg.
	bru dump1x		;and go store

dumpit:inx 8,3		;Catch up on index
dumpad:stx dumpx,3	;pointer
	lda dumpx
	ext seven
	sta dumpbg
	ldx dumpbg,3
!!Page 184
	stx dumpx,3
	srd 12		;Position
	add dmpbbz		; and blank fill
	spb dumpa1,1	;convert
	spb dumpbd,1	;and store
dumpwd:spb dumpwb,1	;Set sign and bit 1
	spb dumpbd,1	;Build 7
	spb dumpbd,1	; characters per word
	inx 1,3		;Count for next word
	bxl 26,2		;Test end of image
	bru dumpwd		; no.
	inx 1,2		;Leave a blank space before BCD dump
	ldx dumpx,3		;Build BCD portion of line
dump03:lda 0,3
	inx 1,3		;Step block counter
	spb dump1x,1	;Go store
	bxl 35,2		;Test for end-of-line
	bru dump03
	bcs bpn,6		;Wait for printer
	bru *-1
	sel 6
	oct 2600000
dump04:add 0,1		;[Constructed ...]
	ldx 8K,3
	dld dumpio		;Get addresses and switch
	xaq
	dst dumpio
	sto dump04,3
	sto dump1x+1,3
	ldx dumpbg,3
	ldx 8K,2
	bru dumpov		;Get back

dumpex:ldx dumpx1,3	;Get return location
	ldx 8K,3		;and restore x3
	bru 1,1		;and return


dumpbk:dec dumpa		;Dump buffer areas
	dec dumpb
obug1:dec t+16		;Dump quite a bit
	dec sclock
obug2:dec kclosk
	dec mkpr1-1		;Dump save area
obug3:dec iprior
	dec eplst-1
dumpmb:oct 3777774	;Mask
	alf & & 0		;and leading blanks
.bgst.:spb bgst,1		;Entry to set time in register
	dec -1
bgnew:oct 374525		;New time is...
!!Page 185
	alf W T
	alf IME
	alf & IS
bgnew1:alf & & & 
	alf & & & 
	alf & HO
	alf URS
	oct 333755
dumpa:bss 40
dumpb:bss 40
sloc1:dec 0			;Location counter
out:	alf OUT
oct:	alf OCT
comnic:alf COM
.coma.:bru coma
.comb.:bru comb
.comc.:bru comc
com3:	oct 73		;Comma
col3:	oct 15		;Colon
bgmax:oct 1764370		;Nearly 24 hours [518392 D = 23:59:58:4]
bgkey:oct -53		;Dollar sign
bgtim:alf TIM		;Time check constant
cbugas:bss 1
cbugbs:bss 1
cbugbc:bss 1



	org t			;Temporary storage
dumpio:bss 2		;Flip-flop for print areas
dumpbg:bss 1		;Block currently being typed (must be even)
dumped:bss 1		;End of print block (must be in order)
dmpmsk:bss 1		;oct 3777774 - these must be in order and
dmpbbz:bss 1		;the above must be even
dumpx:bss 1			;Index register 3 temporary save
dumpx1:bss 1		;Dump entry save
sloc:	bss 1			;Location counter for octal insert
ch2:	bss 1			;Character storage - they must be in order
ch2:	bss 1
com1:	bss 1
col1:	bss 1
dtmp:	bss 1
	tcd lovwrt

	stl			;Lister for GAP tapes
	ejt
!!Page 186  10/10/02
,	This routine will list a GAP assembly tape
,	[from handler] 3 provided it is written in
,	binary print-line images.
,	It will also punch the corresponding binary
,	deck.

,	   1)  EJT cards will cause a slew but will
,	       not be printed
,	   2)  NAM cards will change the title as
,	       in regular GAP assemblies
,	   3)  REM cards will be printed with the op
,	       code delted and the remarks field
,	       shifted over two words.


	org pernum
	dec 22
	dec G/P


	org execov
	lda 8K		;Initialize to rewind tape 3
	sta gpoin
	dld .gst.,3		;and set up branch in list
	spb insert,2
	sta ovtsk		;Save where
	sta z1		;and save exit register
ginit:dld gareas,3	;Initialize buffer areas
	dst gin
	dst io1		;Reset start load area
	ldz			;Set page flag for first time
	sta gejtf
	lda dumpbl		;Clear out title line
	lqa
	dst gtl,3
	inx 2,3
	bxl 40,3
	bru *-3
	lda mask6		;oct 3000000
	sta gtl-1,3		;and set page count to zero
	ldx 8K,3		;and restore register

,	This is the common entrance point

gst:	bcs btn,1		;Check on tape
	bru 2,1
	bcs bpn,6		;and printer
	bru 2,1
	bcs bef,1		;Ignore end-of-files
	bru gread0		;Get select instruction
	lda swflg		;Check if billing on
!!Page 187
	bod			;is on if odd
	bru 2,1
	rcs			;or switch 0 down
	bmi
	bru 2,1
	ldx gpoin,2		;Get routine pointer
	bru *+1,2
	bru grwd		;[0] Rewind
	bru gprm		;[1] Prime buffers
	bru gslt		;[2] Slew to top of page
	bru gslw		;[3]
	bru gp0		;[4] Pass 0
	bru gp1		;[5] Pass 1
	bru gp2		;[6] Pass 2
	bru gjt		;[7] Eject
	bru gpun		;[8] Punch card
	bru gcon		;[9] and search for next assembly
.gprm.:equ one
.gslt.:equ two
.gslw.:equ three
.gp0.:equ four
.gp1.:equ five
.gp2.:equ six
.gjt.:equ seven
.gpun.:dec 8		;These must be indexed



grwd:	sel 1			;Rewind tape 3
	rwd ,3
	lda cmessb		;Check batch flag
	bze			;if not on, continue
	spb mesg,2		;Acknowledge
	dec pcr
	spb gslt8,2		;and slew to top of page
	lda .gprm.
	sto gpoin
	bru 2,1


gprm:	bcs brw,1		;Wait for rewind
	bru 2,1
	bpn			;and punch
	bru 2,1
	sel 1
	rtb io1,3
	    %40
	dld io1		;Scan for GAP Pass 0 message
	dcb ggap,3
	bru 2,1		;Exit if not
!!Page 188
	bru *+2		;yes
	bru 2,1		;no, so exit
	lda .gp0.		;Set for pass 0
	sto gpoin
	spb gslew,2		;Slew two lines
	spb gslew,2		;Slew total of 6 lines first time
	spb gslew,2
	bru 2,1


gslt8:lda gpoin		;Save pointer
	sta gpsav
	stx gpsav+1,2
	lda .gslt.
	sto gpoin
	bcs bpn,6		;Wait for printer
	bru gex		;and crump if not ready
gslt:	sel 6			;Slew to top
	slt 8
	ldx gpsav+1,2	;Restore registers
	lda gpsav
	sta gpoin
	ldz
	sta gline
	bru 2,1		;and return


gslew:lda gpoin		;Save pointers
	sta gpsav
	stx gpsav+1,2
	lda .gslw.		;and set for slew two lines
	sto gpoin
	bcs bpn,6		;Wait for printer
	bru gex
gslw:	sel 6
	slw 2
	ldx gpsav+1,2	;Restore registers
	lda gpsav
	sta gpoin
	bru 2,1		;and return


gp):	dld gin		;Pass 0 - get buffer addresses
	sta z2
	sto gprnt1,3
	xaq
	dst gin
	sto gread,3
	lda mblnk		;Preset end of line
!!Page 189
	sta 24,2
	lda 0,2		;and check for end of pass 0
	sub gend1,3
	bnz
	bru gprnt		;no
	dld 2,2		;Check rest of field
	dcb gpass,3
	bru gprnt		;no
	bru *+2		;yup
	bru gprnt
	lda d54,3
	sta gline		;and set line so it will slew next time
	lda .gp1.		;and set for Pass 1
	sto gpoin
	bru gprnt


gp1:	dld gin		;Get last used address
	sta z2		;and put in register
	xaq			;flip
	dst gin		;re-save
	sto gread,3
	lda sign		;Set negative bit beforehand
	ory 23,2		;Do not print sequence numbers
	lda 0,2		;Check for end pass 1
	sub gend1,3
	bze
	spb gp1chk,1	;Check it out
	lda 2,2
	ext gzone,3		;Check for zone bits
	bze
	bru *+4
gp1b:	lda z2		;Get read-in address
	sto gprnt1,3
	bru gprnt		;and print - no unpacking
	lda gin+1		;Get address
	add d30		;and increment for expanded symbol table
	sto gprnt1,3	;and set up for instruction
	sta z1		;and register 1
	add d36,3
	neg			;Construct end-of-line
	sto gpck2,3		;End of line test

gpack:dld 0,2		;Get symbol
	dst 0,1		;and put away in expanded line
	dld gibn,3		;Get special blanks
	sta 2,1		;put away first part
	lda 2,2		;Get address of symbol
	sta 3,1		;put away msh
	lda 3,2		;Get lsh
	dst 4,1		;and put away with trailing blank
!!Page 190
	inx 6,1
	inx 4,2
gpck2:bxl *,1		;Test end-of-line
	bxl gpack
	bru gprnt		;and print the stupid line

gp1chk:dld 2,2		;Check rest of field
	dcb gpass,3
	bru 1,1		;No
	bru *+2
	bru 1,1
	lda d54,3		;Yes, pre-set for slew
	sta gline
	lda .gp2.		;Set for pass 2
	sto gpoin
	dld gin		;Modify addresses to leave for punch
	sto gidnt1,3
	sto temp
	dad go100,3
	dst gin
	sto gread,3
	ldx zero,1		;Set up for identifying card punch
	dld gident,3
gidnt1:dst 0,1		;Set in spare buffer
	inx 2,1		;Count
	bxl 26,1		;and check for buffer filled
	bru gidnt1		;Still more
	ldx temp,1		;Get address
	wcd 0,1		;and punch card
	bru gp1b		;and get back



gp2:	ldx gin,2		;Get area last read into
	lda 40,2		;and check residue word
	bze
	bru gpunch
	bpl			;If greater than 40 words, ignore
	bru gread0
	lda sign
	ory 33,2		;Set minus sign in word
	dld gin
	sto gprnt1,3	;and print instruction
	xaq			;Flip
	dst gin		;and save
	sto gread,3		;and set in tape instruction
	lda 0,2		;Get first word and check for ENDGAPPASSES
	sub gend1,3
	bze
	spb gp2chk,1	;Check out rest of field
	lda 10,2		;Now get op code - damn fool odd word
!!Page 191
	srd 18
	lda 9,2
	ext gmask,3		;This is the odd word
	sld 6			;Now get the whole op code
	cab gejt1,3		;and check for EJT
	bru gprnt		;no
	bru gejt
	cab gnam1,3		;[Check for NAM]
	bru gprnt
	bru gnam
	cab grem1,3		;REM
	bru gprnt
	bru grem


gprnt:sel 6			;Print the line
	z26 --
gprnt1:add --
	lda gline		;and now check for end of page
	ado
	sta gline
	sub d54,3
	bpl
	bru gejt		;Yes, eject and print title if called for


gread0:sel 1		;Tape read
gread:rtb io1,3
	    %40
gex:	ldx ovtsk,1		;Get entry point
	bru 2,1		;and get out


gejt:	lda gline		;Check if just slewed to top of line
	bze			;If so,
	bru gread0		;ignore ejt card
	spb glst8,2		;Else slew to top of page
	spb gslew,2		;and slew two lines
	lda gpoin		;Then check for pass 2
	ext 8K
	sub .gp2.
	bnz
	bru gejt2		;no
	lda .gjt.		;Set for heading line
	sto gpoin
	bcs bpn,6		;Check out printer
	bru gex		;and wait if not
gjt:	sel 6			;Print heading line
	z26 --
	z03 gtl,1
	lda gtl+39,3	;Page number
!!Page 192
	set decmode		;and step
	add gejtf		;with flag
	set binmode
	sta gtl+39,3	;and restore
	ldo			;and set flag for subsequent times
	sta gejtf
	lda .gp2.		;and restore pointer
	sto gpoin
	bru gread0
gejt2:spb gslew,2		;Slew two lines at top
	bru gread0


gnam:	lda gin+1		;Last area read into
	add d17,3		;and get remarks field - we hope
	add smove1		;and construct move instruction
	sta *+2,3
	dld gnam2,3
	mov --


grem:	dld grem2,3		;Get constant
	lda gin+1		;Then buffer address
	add d11,3		;and step to remarks field
	add smove1		;Construct move
	sta *+2,3
	sub two		;and move remarks field over two left
	mov --		;on page
	lda dumpbl		;Blank out end of line
	lqa
	dst 30,2		;blank end-of-field
	sta 9,2
	sta 10,2		;This should get rid of damned remark
	bru gprnt


gpunch:lda .gpun.,3	;Punch binary card
	sto gpoin
gpun:	bpn			;Check out punch
	bru gex
	dld gpmov,3		;Get Q portion for move
	lda gin		;Area last read into
	add smove1		;and construct instruction
	sta *+3,3
	sub o100		;and set down to multiple of 128
	sta z2
	mov --
	wcb 0,2
	lda .gp2.		;Return to pass 2
	sto gpoin
	bru gread0
!!Page 193


gp2chk:lda 1,2		;Check rest of field if end
	sub gend1+1,3
	bnz
	bru 1,1
	dld 2,2
	dcb gend2,3		;Check for PASSES
	bru 1,1		;no
	bru *+2
	bru 1,1
	spb gslt8,2		;Slew page
	spb gslt8,2		;Again
	dld gin		;Set addresses back as originally
	dsu go100,3
	dst gin
	ldx ovtsk,1		;Get entry point
	lda .gcon.,3	;and set up for continuation
	sta 0,1
	lac			;and set timer in case tape runs away
	add six
	sta gpsav


gcon:	bpn			;Wait for punch so as not to wipe out last
	bru gex		;transfer card
	lda swflg		;Check billing flag
	bod			;if odd, then billing on
	bru 2,1		;billing on...
	rcs			;and then check switch 0
	bmi
	bru 2,1		;If down, crump
	bcs btn,1		;Else check tape
	bru gtchk		;if not ready, go check
	lda gline		;and search six entries from tape
	ado
	sta gline
	sub ten
	bpl
	bru gendp		;The P is for permanent
	lac			;Step timer if OK
	add six
	sta gpsav
	dld gin		;Get addresses
	sto gread,3		;and do it backwards
	xaq
	sta z2
	dst gin
	dld 0,2
	dcb ggap,3		;Check for GAP 0
	bru gread0
!!Page 194
	bru *+2
	bru gread0
	lda .gst.,3		;Get original entry
	sta 0,1		;and set up
	lda .gprm.		;Set for buffer printing
	sto gpoin
	ldx zero,2		;Set up for end identifier
	dld gident,3
	dst io2,2
	inx 2,2		;Count
	bxl 26,2		;and check
	bru *-3
	wcd io2
	sel 1			;Now read tape backwards
	rbb io1,3
	    %0
	bru ginit		;and set for new listing



gtchk:lac			;Check if time up
	sub gpsav
	bmi			;No, then keep on
	bru 2,1
	lda .gst.,3		;Get original entry and prepare to hang
	sta 0,1		;tape completely as it is running awat

gendp:sel 1
	rwd ,3
	ldx zero,2		;Set up for end identifier
	dld gident,3	;Set up for last card
	dst io2,2
	inx 2,2		;Count
	bxl 26,2		;and check
	bru *-3
	wcd io2
	spb gslt8,2
	lda cmessb		;Check batch flag
	bze
	bru iredy		;normal crump if off
	ldx ovtsk,1		;Else recall monitor
	spb irase,2
	ldz			;Reset pointer
	sta ovtsk
	sta z2
	inx batch,2		;Get monitor
	lmo
	sta io1		;Set front card in
	bru pgetb

!!Page 195

gtl:	bss 40		;Title line
gnam2:dec gtl		;Move constant
	dec -15
.gst.:spb gst,1
.gcon.:spb gcon,1
gareas:dec io1
	dec io2
gend1:alf END
	alf GAP
gend2:alf PAS
	alf SES
gpass:alf & PA
	alf SS
gibn:oct 603535		;Fudge blanks
	alf & & & 
ggap:	alf GAP		;Starting checker
	alf & 0
gpmov:dec 0
	dec -40		;Forty words to a binary card
go100:oct 100		;Buffer-areas-adjust constant
	oct 100
gident:alf ABC
	alf DEF
grem2:oct 0
	dec -21

gejt1:alf EJT
gnam1:alf NAM
grem1:alf REM
d11:	dec 11
d17:	dec 17
d30:	dec 30
d36:	dec 36
d54:	dec 54
gmask:oct 3770000
gzone:oct 3171717



	org t			;Temporary storage
gin:	bss 2
gpoin:bss 1
gpsav:bss 2
gline:bss 1
gejtf:bss 1			;Page count flag
	tcd lovwrt		;End

	stl			;Sysout lister
	ejt
!!Page 196
,	SYSOUT lister

,	The sysoute lister will process tapes written
,	by batch or any tapes in the same format.

,	It can be called directly from the batch
,	ovrlay or from the console typewriter.
,	If it is called from BAT it checks to see
,	which tape was written on last, and waits
,	until the proper tape is on handler seven.
,	If called by the typewriter it assumes the
,	tape is already on seven.
,	It automatically flip-flops between handlers
,	6 and 7.

,	The tape format is two control words followed
,	by the data.  Each has either the word count
,	or zero in word two (almost).  All numbers
,	are octal.

,	Start output file  0 in both words
,	Print              1 in the low-order end of
,	                   word one, the high order
,	                   high order bits of control
,	                   word one.  Word two has the
,	                   length in the low-order
,	                   end and the high-order
,	                   is the same as the high
,	                   order part of controller
,	                   word two.
,	Set format         2 in word one.  This record
,	                   contains the horizontal
,	                   format information to be
,	                   used in all subsequent
,	                   print with format records.
,	                   Word count in two.
,	Punch decimal      7 in word one, count in two
,	Punch binary       10 in one, count in two
,	Punch full         11 in one, count in two
,	End of output file 20 in one, 0 in two


,	An EOF indicates the end

,	Buffers used
,	   sio1   600    80 words - punch
,	   sio2   720    40 words - print
,	   sio3   770    40 words - format line
,	   sio4  1040   110 words - tape read-in
,	   sio5  1217   110 words - tape read-in

!!Page 197
,	Flags and things
,	slbufp  Buffer flip-flop           upper
,	sllen   Words left in each buffer  lower
,	sllen2  Words used in first buffer lower
,	slcon   Control words              upper
,	slbuff  Buffer to use              upper

,	The tape subroutine was put on the end at
,	load time.

	org pernum
	dec 24
	dec S/O

	org execov

	dld .sle2.,3
	spb insert,2	;Put in task list
	sta ovtsk		;Save place in list
	spb messg,2		;Acknowledge receipt
	dec pcr		; with carriage return
	spb treqb,2		;Now rewind 7
	sel 1
	rwd ,7
	oct 0			;[Completion] flag
	spb slext,2		;Set up exit
	lda *-2,3
	bze
	bru 2,1		;Not ready
	bcs brw,1		;Now see if done rewinding
	bru 2,1		;No
	bcs bpn,6
	bru 2,1
	sel 6			;Start with a slew
	slt 8
,	Prime both buffers - sio4 and sio5
	spb slrnr,2		;Read
	spb slrnc,2		;Wait and compute length
	spb slrnr,2		;Get next one
sllst2:lda slbufp,3	;Find beginning of output
	sta z2		;Get buffer address
	dld 0,2		;See if start
	dcb zero
	bru *+2		;Nope
	bru sllst3		;OK
	spb slrnc,2		;Wait for last read
	spb slrnr,2		;Get next record
	bru sllst2		;and check again
sllst3:sta sllen2		;Initialize
!!Page 198
	bru slgp		;and start

,	Subroutine to get next record.  Entered on 2.
,	Will check the buffer flip-flop read into the
,	first and exchange them.

slrnr:stx slt1,2		;Save entrance
	dld slbufp,3	;Buffer pointers
	sto slrnr1,3	;Set for read
	xaq
	dst slbufp,3	;and exchange
	spb treqb,2		;Tape routine
	sel 1
slrnr1:rtb sio5,7
	   %110
slrnrf:oct 0			;flag
	dld sllen		;Length
	xaq			;switch also
	dst sllen
	ldx slt1,2		;Get return back
	bru 1,2

,	Will compute length of record just read by
,	SLRNR and store in length list.  Maximum
,	record length is 110 words.
,	Exits with length in A

slrnc:stx slt1,2		;Save entrance
	spb slfxt,2		;Set up exit
	lda slrnrf,3	;Check flag
	bze
	bru 2,1		;Not ready
,	If EOF found, then end of sysout tape
	sra 2			;Check flag for EOF
	bod
	bru slend		;Finished
	lda slrnr1,3
	ext mask10		;3700000
	sta z1		;Address read into
	lda 110,1		;Get residue word
	bpl			;Make sure record is not too long
	bze
	bru slrnc1		;OK
	ldz			;Bad
	bru *+2
slrnc1:add sd110,3	;Now have length
	sta sllen+1		;and save
	ldx slt1,2		;Get return
	bru 1,2		;and get back

,	Pull out the parameter words and make an
!!Page 199
,	initial check on them.

slgp:	bss 0
	lda slrf,3		;See if another buffer needed
	bpl
	bru slgp1		;No
	lda sllen		;yes, so fudge length back
	sta sllen+1
	dld slbufp,3	;Flip buffers back
	xaq
	dst slbufp,3
	spb slrnr,2		;get buffer
	sta slbf,3		;Reset read flag - return is positive
slgp1:lda sllen		;and change length pointers
	bnz
	bru slgp2
	sta sllen2,
	spb slrnc,2		;Check last read done
	spb slrnr,2		;and get more
	bze
	bru *-3		;I can go in circles too.
slgp2:sub two
	sta sllen
	lda sllen2		;Words used
	sta z2
	add two
	sta sllen2
	lda slbufp,3	;Buffer pointer
	sto slgp3,3		;set up loads
	ado
	sto *+1,3
	lda *,2		;Modified to come from right buffer
	sta slcon+1,3	;Save control words
slgp3:lda *,2
	sta slcon,3
	ext mask7		;Just save low order - 3777700
	sta z2
	bxl 3,2		;Make first check on control words
	bru slo2		;Set up buffer 2 - print
	bxl 10,2
	bru slo1		;Set up buffer 1 - punch
	bxl 17,2
	bru slcon1		;Control record
	bru slill		;Illegal control word

slo1:	lda sdio1,3		;dec sio1
	sta slbuff		;Buffer to move to
	ldz
	sta slmin		;Set for punch
	bru slmov		;yes, move in

!!Page 200
slo2:	lda sdio2,3		;dec sio2
	sta slbuff		;Buffer to move to
	lda so611,3
	sta slmin		;Set up for print
,	Ready, so move

,	If enough words remain in input buffer, move
,	directly to output buffer.  If not, fudge like
,	mad.

slmov:lda slcon+1,3	;Second control word
	ext slms1,3		;3777600
	sta slt2		;Save for a while
	cab sllen		;Words left
	bru slmov1		;OK
	bru slmov1		;Still OK
	bru slmv		;Partial move and re-read
slmov1:neg			;Set up move command
	xaq
	lda slbufp,3	;Get buffer address
	add sllen2		;get from address
	sto slmg2,3		;Set up move instruction
	lda slbuff		;Address to move to
	dst slmc1+2,3	;and constant
	lda sllen		;Words left
	sub slt2		;get new total
	sta sllen		;and save
	lda sllen2		;Get new total of words used
	add slt2
	sta sllen2
	spb slext,2		;Get out
	ldx slmin,2		;Either printer or punch
	oct 2556007		;Either printer or punch
	bru 2,1
slmg:	dld slmc1,3		;Get to address and length
slmg1:mov 1			;Filled in
	dlc slmc1+2,3	;Second move
slmg2:mov 1			;Filled in
	sta slmc1+1,3	;Reset move constant
	bru slexe		;and execute
,	Not enough words left in present buffer

slmv:	sub sllen		;Get left-over words
	sta slt2		;Temp location
	lda sllen		;Get words to move
	neg
	xaq
	lda slbufp,3	;Buffer address
	add sllen2		;make from address
	sto slmg1,3		;Set up move instruction
	lda slbuff		;Move to
!!Page 201
	dst slmc1,3		;move constant
,	Compute next move-to address
	add sllen
	sta slbuff
	spb slpnc,2		;Get length info on last read
	sta sllen		;Length left in A after calculation
	dld slbufp,3	;Flip buffers manually
	xaq
	dst slbufp,3
	lmo
	sta slrf,3		;Set read flag for slgp
	ldz
	sta sllen2		;Reset words used
	lda slt2		;Get number of left over words
	bru slmov1		;and enter middle of move routine

,	Will pick up instructions and execute them
slexe:lda slcon,3		;Get first control word
	ext mask7		;get code 3777700
	add 8K
	sta z2		;Have upper memory branch
	bru *+1,2
	bru slsta		;Start file
	bru slpri		;Print
	bru slfor		;Format line
	bru slgp		;Illegal next control word
	bru slgp
	bru slgp
	bru slgp
	bru slpud		;Punch decimal
	bru slpub		;Binary
	bru slpuf		;Full

,	Print routine
slpri:lda slcon,3
	sta slprie+1,3	;Get control words
	lda slcon+1,3
	sta slprie+2,3
	lda slforf		;Format address, if any
	sto slprie+1,3	;put in instruction
	lda sdio2,3		;Buffer address
	sto slprie+2,3
slprie:sel 6
	oct 0			;Filled in earlier
	oct 0
	bru slgp		;and start again

,	Set up format line
slfor:dld slform,3	;Format move constant
	mov sio2		;to format line
	lda sdio3,3
!!Page 202
	sta slforf		;Put in format address
	bru slgp		;and continue

slpud:wcd sio1		;Punch decimal
	bru slgp
slpub:wcb sio1		;Binary
	bru slgp
slpuf:wcf sio1		;Full
	bru slgp
,	Illegal control code so compute where to find
,	next useful record
slill:lda slcon+1,3	;Get length
	ext slms1,3		;3777600
	cab sllen
	bru slill2		;Can stay in same record
	bru slill2
	sub sllen		;Get words left over
	sta slt2
	spb slrnc,2		;Wait
	spb slrnr,2		;Get next one
	lda sllen		;Get new length
	sub slt2
	sta sllen
	lda slt2
	sta sllen2		;Words used
	bru slgp		;Start again
slill2:bss 0		;Stay in same buffer
	lqa
	add sllen2		;Get new words used
	sta sllen2
	xaq			;Get A back
	sub sllen
	neg			;Now have words left again
	sta sllen
	bru slgp		;and continue

,	Start output file - 27-word image of name card

slsta:lda slbufp,3	;Buffer address
	add two
	sto *+2,3		;Set up move
	dld slsta1,3	;Get card image to punch area
	mov --		;Filled in
	lda sign
	ory sio1+26
	spb slext,2		;Prepare to exit
	bcs bpr,6		;Test both printer
	bpn			;and punch
	bru 2,1		;Get out
	sel 6
	wpl sio1		;Name line
!!Page 203
	ldz
	sta sllen
	bru slpud		;Punch card and continue

slsta1:dec sio1
	dec -27


,	Examine control records - these are by them-
,	selves.
slcon1:bxl 16,2		;Check to see if legal
	bru slill		;Yes
,	End of output file
	spb sslt8,2		;Slew to top of page
	spb slext,2
	bpn
	bru 2,1
	ldx zero,2
	dld sliden,3	;Pretty last card
	dst sio1,2
	inx 2,2
	bxl 26,2
	bru *-3
	wcd sio1
	bru sllst2		;and look for zeros


slend:spb treqb,2		;Tape routine
	sel 	
	rwd ,7		;Rewind 7
	oct 1			;Set to done
	spb tclos,2		;Close out tape routine
	spb sslt8,2		;Slew to top of page
	bru iredy		;and all done

sliden:alf ABC
	alf DEF

,	Normal entrance is here
sle2:	ldz
	rcs
	bmi			;punt if zero is down
	bru 2,1
	ldx slpoi2,2	;Set up re-entrance
	bru 1,2		;and go there

,	Slew to top of page
sslt8:stx slt1,2		;Save entrance
	spb slext,2
!!Page 204
	bcs bpn,6
	bru 2,1
	sel 6
	slt 8
	ldx slt1,2		;Get back
	bru 1,2

,	Enter on 2 - sets up exits
slext:stx slpoi2,2
	ldx ovtsk,1
	bru 1,2		;and get back

slrf:	dec 0			;Read flag - minus if read necessary aftr move

.sle2.:spb sle2,1
slms1:oct 3777600
sd110:dec 110
slbufp:dec sio4		;Flip-flop buffer addresses
	dec sio5
sdio1:dec sio1
sdio2:dec sio2
sdio3:dec sio3
slform:dec sio3		;Format-move constant
	dec -40
slmc1:dec 1			;Move constants
	dec 0
	ddc 0
slcon:ddc 0			;Control word storage
so611:oct 611		;used to change punch to printer


	org ta		;Storage for lister after tape subroutines

sllen:bss 2			;Words left
sllen2:bss 1		;Words used
slt1:bss 1			;Temp storage
slt2:bss 1			;Temp storage
slforf:bss 1		;Format line address or zero
slpoi2:bss 1
slbuff:bss 1		;Buffer to use
slmin:bss 1			;Used to index bpn

	loc 6000
slfix:bss 0			;Get tape subroutine on end
	lda tap+2		;Disk address of subroutine
	sta *+5
	bcs brn,0
	bru *-1
!!Page 205
slfir:sel 0
	prf ,0
	oct 0
	bcs brn,0
	bru *-1
	sel 0
	rrd ,3
	    %treqst
	bcs brw,0
	bru *-1
	bcs ber,0		;Check errors
	bru slfir

	bru lovwrt		;now go and load

	tcd slfix

	stl			;Time-Sharing Operations Summary
	ejt
!!Page 206

,	This efficiency summary of time-sharing
,	computes the following information
,	and writes it on the disk every ten
,	minutes...
,	1) Percentage of running time over total
,	   on-time.
,	2) Percentage of swap time over on-time.
,	3) Percentage idle time over total on-time.
,	4) Percentage disk times other than swap over
,	   total on-time.

,	The operation summary is called every ten
,	minutes through the wait loop.  It keeps a
,	summary for half-hour periods, then re-initia-
,	lizes itself for the next half-hour period.

	org pernum
	dex 26
	dec summry

	org execov
	dld .eff1.,3	;New entry
	spb insert,2
	sta z1		;and save return
	bru 2,1		;and get out


eff1:bss 0
	spb irase,2		;Delete entry otherwise
	spb dskb,2		;Pick up previous summary
	spb dskop,2
	z12 1
	dec fclock
	oct 402
	nop			;[Ignore error return?]
	spb relin2,		;and get rid of disk
	ldx zero,1		;Else move summary into area
	lda fkedit,1
	sta f4,1
	inx 1,1		;Step pointer
	bxl fkbat-f3,1	;Test for end
	bru *-4
	lda fclock
	bze
	bru fsumr		;Need to reset everything
	lac			;Check time
	sub fclock		;Get elapsed time
	sta flapse		;and check for
	bmi
	bru fsumr		;If past midnight, restart everything
!!Page 207  10/11/02
	lda fcnt		;Check for over half hour
	ado			;step
	sta fcnt		;and store
	bru fcrest		;Now compute

fsumr:ldz			;Re-initialize
	sta fclock
	dld fmid,3		;Midnight
	mov fclock
	sta acrun		;Zero accumulated counters
	sta acswap
	sta acdisk
	sta acbat
	sta flapse		;and zero out elapsed time
	sta z1
	lac			;Reset counters and pointers
	sta fclock
	sta acstrt		;accumulated start
	spb time,2
	dst fstim
	dst astim+2
	lda F4,1
	sta fkedit,1
	inx 1,1		;Step
	bxl fkbat-f3,1	;Test for end
	bru *-4


fcrest:bss 0
	spb time,2		;Get time for output line
	dst ssump+2,3	;set in line
	lda fkstrt
	sta ftem		;Temporary location
	spb pcent,2		;Compute percentage running time
	sta ssr,3		;Run time
	lda fkdump		;Swap times
	add fkntnu		;Dump 6 and continue
	sta ftem+1
	spb pcent,2		;Compute percentage of swap times
	sta sss,3		;Swap time
	lda fkread		;Read-ins
	add fkwrit
	add fkedit		;Edits as well
	add fktea		;and teach, for want of a better place
	sta ftem+2
	spb pcent,2		;Compute percentage miscellaneous
	sta ssm,3		;Misc. time
	lda fkbat		;Get batch time
	sta ftem+3
	spb pcent,2		;Compute percentage batch
	sta ssb,3		;Batch time
!!Page 208
	lda flapse		;Get elapsed time
	sub ftem		;and try to ensure 100 percent
	sub ftem+1
	sub ftem+2
	sub ftem+3
	bmi
	ldz			;Make it look nice
	spb pcent,2		;Get percentage idle time
	sta ssi,3		;Idle time
	dld .effe.,3	;Efficiency intermediate entrance
	spb insert,2
	sta ovtsk		;Save location
	sta z1		;In case printer not working
	dld fstim		;Get starting time
	dst ssump+10,3	;Set in print line
fcre2:bcs bpn,6		;[Allow printouts to be omitted]
	bru fcre21		;Just punt if not ready
	sel 6
	wpl ssump		;Summary printout
	spb eexit,2
	bcs bpn,6
	bru 2,1		;Wait again
	sel 6
	slw 2			;Slew two lines
	spb eexit,2
	bcs bpn,6
	bru 2,1
	sel 6
	wpl ssump+6		;Get short summary
	spb eexit,2
	bcs bpn,6
	bru 2,1
fcre21:lac			;Get accumulated times
	sub acstrt
	sta flapse
	lda ftem
	add acrun
	spb pcent,2
	sta ssr,3
	lda ftem+1
	add acswap
	spb pcent,2
	sta sss,3
	lda ftem+2
	add acdisk
	spb pcent,2
	sta ssm,3
	lda ftem+3
!!Page 209
	add acbat
	spb pcent,2
	sta ssb,3
	lda flapse
	sub acrun
	sub acswap
	sub acdisk
	sub acbat
	sub ftem
	sub ftem+1
	sub ftem+2
	sub ftem+3
	bmi
	ldz			;Make pretty
	spb pcent,2
	sta ssi,3
fcre3:bcs bpn,6		;[Allow printouts to be omitted]
	bru fcre31		;punt if not ready
	sel 6			;Know printer is ready
	slw 2			;Slew 2 lines
	dld astim2		;Set time for long run summary
	dst ssump+10,3
	spb eexti,2
	bcs bpn,6
	bru 2,1
	sel 6
	wpl ssump+6		;Write long run summary
	spb eexit,2
	bcs bpn,6
	bru 2,1
	sel 6
	slw 4			;Slew four lines
	spb irase,2		;Get rid of task
,	See if necessary to reset summary
	lda fcnt		;Check half-hours
	sub three
	bmi
	bru fcre4		;OK, so punt
,	Time to restart so add to accumulated things
	lda ftem
	add acrun
	sta acrun
	lda ftem+1
	add acswap
	sta acswap
	la ftem+2
	add acdisk
	sta acdisk
!!Page 210
	lda ftem+3
	add acbat
	sta acbat
	ldz			;Restart
	sta fclock
	dld fmid,3
	mov fclock
	sta z1
	lac
	sta fclock		;Starting time
	spb time,2
	dst fstim
	lda f4,1
	sta fkedit,1
	inx 1,1
	bxl fkbat-f3,1	;Check for end
	bru *-4
fcre4:spb dskb,2		;and get disk
	spb dskop,2		;and write out summary
	z37 1			;Write, 1 record
	dec fclock		;From summary area
	oct 402		;Disk address
	nop			;Should never return here, but punt if it does
	spb relin2,		;Relinquish disk
	lac			;and set interval for next time
	add finc,3
	bmi			;Check for too large
	bru *+4
	cab fmid1,3		;Check for midnight
	bru *+3		;OK
	bru *+1
	lda fmid1,3		;Too close
	sta .eff
	ldz			;Reset busy flag
	sta bzyf
	bru 2,1		;and get out


pcent:maq			;Compute percentage
	mpy fcent,3		;Get one extra digit
	dvd flapse		;and get percentage twice as large
	ado			;Round upwards
	srd 20		;Get in Q less one bit
	dvd ten		;Convert to decimal
	cab finc2,3		;Check for funny case
	bru pcent1		;OK
	bru *+1		;Yes
	lda finc3,3		;Get 100 percent
	bru 1,2		;and get out
pcent1:bze			;Check for leading zero
	lda o60		;replace by zero if so
!!Page 211
	sla 6			;Shift to middle
	add blzz		;and get rid of high-order zero
	sta mstemp+1	;First character
	laq			;Remainder is second
	add mstemp+1	;and total up
	bru 1,2


effe:ldx epoi2,2		;Get correct re-entrance
	bru 1,2		;and go there

eexit:stx epoi2,2		;Temporary exit
	ldx ovtsk,1
	bru 1,2		;and just go back

,	Print lines for printer summary
ssump:alf TIM
	alf E  
	alf & & & 
	alf & & & 
	oct -606060
	oct 0
	alf SUM
	alf MAR
	alf Y F
	alf ROM
	alf & & & 
	alf & & & 
	alf & & & 
	alf RUN
ssr:	alf & & & 
	alf &%  
	alf SWA
	oct 473535
sss:	alf & & & 
	alf &%  
	alf BAT
	oct 233035
ssb:	alf & & & 
	alf &%  
	alf MIS
	oct 233535
ssm:	alf & & & 
	alf &%  
	alf IDL
	oct 253535
ssi:	alf & & & 
	oct -746060


.eff1.:spb eff1,1
!!Page 212
.effe.:spb effe,1
	dec -1
fmid:	dec flapse
	dec f1-f2
finc:	oct 7020		;10 + fraction
finc2:dec 10
finc3:alf 100
fcent:dec 200		;Percentage constant
fmid2:oct 1764375		;[23:59:59 3/6]
	dec f2		;Just to reference them [?]
	dec f3

	org t
epoi2:bss 1

	loc 6000
,	Check for printer
fpc:	ldx 8K,3
	ldz
	rcs
	sra 1			;See if switch 18 down
	bev
	bru lovwrt		;No, so load
	bru *+2		;If so, no printer
	nop
	lda *-1		;Get NOP
	sta fcre2,3		;and place in test instructions
	sta fcre3,3
	spb $ertyp,2	;and type message
	dec *+2
	bru lovwrt		;and load
	oct 3777777		;No printer
	alf NO
	alf PRI
	alf NTE
	alf R.
	oct 375577

	tcd fpc

	stl			;Card scan
	ttl			;Background monitor overlays
!!Page 213

,	   The batch overlay processes cards for
,	background operation, reading and scanning
,	cards on an API bases, looking for either
,	asterisk-blank-blank type cards, or SCC card
,	   Action on control cards may be of
,	several types.
,	1) If the card type is not in the catalog,
,	it is completely ignored, and the next card
,	is considered.
,	2) If the card can be processed completely
,	within this overlay, that is done, and the
,	overlay then considers the next card.
,	3) If the card can be processed, or calls
,	another overlay (a LIST perhaps) then that
,	overlay is called with provision for return
,	to the BATCH overlay on completion of that
,	task.
,	4) If the card calls for the execution of a
,	major program, then the OBA2, or OBA3 overlay
,	is called in, and control transferred to
,	them.

,	   Batch mode terminates on a hopper empty
,	conditio, or a STOP from the console
,	typewriter.


	org pernum		;Loading information for exec
	dec 28
	dec batch		;Name of overlay


	org execov		;Is standard overlay location.
	spb messg,2		;Acknowledge call with a carriage return
	dec bcr
	sta io1+27		;Set sync word off to a start
	dld .bent.,3	;Insert task into API list
	spb insert,2
	sta ovtsk		;and save return location
	sta z1
	lda bper3,3
	sta bper		;and put period character into lower array
	ldo
	sta cmessb		;Set CMESSB right
	lda io1
,	BFFLG is a 3-way flag.  It is minus if a front
	sta bfflg,3		;card has been found, 0 if needs one, and
,	positive if it needs a back card.
	bpr			;To keep my many friends, check the punch for
	bru *+3		;for them
!!Page 214
	spb messg,2		;Type them a message
	dec bpnr		;Punch not ready
	bru bcd		;and go to normal read
bcr:	oct 375577		;Carriage-return message - given on entrance
bper3:oct 33		;Period - used in card-scan terminate check.
bcom:	eqo 37700


,	Normal entrance is here
bent:	bss 0
	ldz
	rcs
	bmi			;Check console switches
	bru 2,1		;and if negative, crump
	lda typf		;Don't even bother if message being typed
	bnz
	bru 2,1
	ldx bpoin2,2	;Set up return
	bru 1,2		;and execute it
bc1:	oct 546060		;[*-blank-blank]
bc2:	oct 54243		;[(*  ) - (SCC) (maybe the opposite)]
bcd:	spb bcard,1		;Card processing loop - get a card
	lda io1		;Pick up first character
	sub bc1,3		;check for asterisk
	bze
	bru *+4
	sub bc2,3
	bnz			;Check for SCC
	bru bcd		;Non-control, so crump
	dld zero
	dst t			;Set scan array 0
	dst t+2

,	     ---Card scan routine---
,	   Scans a card in IO1, skipping first 6
,	columns, and putting all non-blank characters
,	into T through T+3.  It terminates on
,	reaching column 42, or finding a period,
,	or filling the fourth word of the array.
,	Unused characters in array become 0

	ldx zero,1
	sta io1+1,1		;Set word pointer to 0
	inx 12,3		;Will use xr3 maximum of 12 characters
baw1:	bss 0
	inx 1,1		;Bump up word pointer
	bxh 12,1		;Crump
	bru bex0.1		;See if have front card
	lda io1+1,1
	cab dumpbl		;See if all blanks
	bru *+2
!!Page 215  10/11/02
	bru baw1
	srd 12		;Position
	spb baway,2		;and put it away
	sld 6
	spb baway,2
	sld 6
	spb baway,2
	bru baw1		;and go get next word


baway:bss 0			;Character put-away routine
	stx io1,1		;Save calling register
	ldx io1+1,1		;and get pointer to list
	cab o60		;Check for blank character
	bru *+2
	bru bblnk
	cab bper		;See if terminal period
	bru *+2
	bru bex0.1
	sla 0,3		;Shift
	ory t,1		;and put away
	inx -6,3
bblnk:bxl 1000,3
	bru bawa1
	inx 18,3
	inx 1,1
	bxh 4,1
	bru bex0.1
bawa1:stx io1+1,1
	ldz
	ldx io1,1
	bru 1,2		;and return


bex0.1:bss 0
	ldx 8K,3
	lda bfflg,3		;Check front card status
	bmi
	bru bex1		;yes
	bze
	bru bex0.2		;See if front
	dld t			;See if back
	dcb bbcard,3
	bru bcd		;no
	bru bcback		;yes
	bru bcd
bex0.2:dld t
	dcb bfcard,3
	bru bcd		;Try again
	bru bcfrnt		;Found it
	bru bcd
!!Page 216
bfcard:alf FRO
	alf NT0
bbcard:alf BAC
	alf K00

bex1:	bss 0			;Card scan done - do card catalog scan
	lda ocat+2
	sta btlst+2,3
	sta t+7		;and set for disk routine
bex2:bss 0			;Enter here for each record
	lda btlst+2,3	;Get disk address
	add two		;bump it
	sta btlst+2,3
	spb dramb,2		;Read in a 64-word type record
	dec btlst
	spb bexit,1
	lda btlst+3,3	;Check for operation competed
	bze
	bru 2,1		;exit
	ldx 8K,2
	bru baw3		;and search this record

btlst:bss 0			;Parameter list for catalog read
	z12 1			;1 record at a time
	oct 37700
	oct 0			;Disk address specified
	oct 0			;Flag location ....

,	   Table search to see if card type now in
,	matches some entry in the catalog.
,	All entries consist of a 4-word alphabetic
,	part, plus a 4-word paramater part specifying
,	information about the type - including
,	a branch location to process it.

baw3:	bss 0
	dld bcom,2
	bze
	bru bcdc		;Check for RUN or SYM
	dcb t			;Check first two words
	bru *+2		;no match
	bru bfm		;at least first two match
baw6:	inx 8,2		;Bump up catalog pointer
	bxh 64,2		;Check this record searched
	bru bex2		;yes - so go get next
	bru baw3		;n0 - go try another entry
bfm:	dld bcom+2,2	;Check second two words
	bmi
	bru baw7		;If minus just check first two
	dcb t+2
	bru baw6		;No match
	bru *+2
	bru baw6		;No match, check again.
baw7:	inx bcom+4,2
	lda 0,2
	sta z1
	bru *,1
	bru bcback
	bru bint2
	bru bint
	bru bctype
	bru bcrwnd
	bru bcslew
	bru bext
	bss 4


bcdc:	bss 0
	lda t			;Check for first word RUN or SYM
	cab bsym,3
	bru *+2
	bru bcsym1		;Call SYM-locator
	cab brun,3
	bru bcd
	bru bcsym1		;SYM locator will also position for a RUN
	bru bcd

bcsym1:lda .bsym1,3	;Branch to bsym1
	bru bcbat2		;call BAT2
bcfrnt:spb bcard,1	;Get next card first
	lda .bfrnt,3	;then linkage
	bru bcbat2
bcback:lda .bback,3
	bru bcbat2
bctype:lda 1,2		;Get control word for halt or no-halt
	sta t+1
	spb bcard,1		;and get card to type
	lda .btype,3
	bru bcbat2
bcrwnd:lda .brwnd,3
	bru bcbat2
bcslew:lda .bslew,3
	bru bcbat2


.bsym1:bru bsym1
.bfrnt:bru bfrnt
.bback:bru bback
.btype:bru btype
.brwnd:bru brwnd
.bslew:bru bslew

,	Exit to get to BAT2

bcbat2:bss 0
	sta bbra		;Store branch for BAT2
	set prq		;Make sure to get back
	spb bexit,1		;Get out so messages can be typed
	spb irase,2		;Erase present entry
	ldx zero,2
	inx bat2,2
	bru pgetb		;Get it

bsym:	alf SYM
brun:	alf RUN

,	    Card read routine ---
,	Reads cards - checking for errors, EOF, etc

bcard:bss 0
	bcn
	bru beofc
	ldz
	sta io1+27
	rcd io1
	hcr
bcard0:lac
	add o6o
	sta bclk,3		;Start countdown on reader
bcard1:bss 0
	stx bpoin1,1
	spb bexit,1
	lda io1+27		;Wait for card reader sync in
	bmi
	bru bcard2
	lac
	cab bclk,3		;Countdown on it
	bru *+3		;[Unecessary instruction--could be bru 2,1]
	bru bcnr
	bru bcnr
	bru 2,1
bcnr:	bss 0			;Type card reader not ready and return
	ldx bpoin1,1
	spb messg,2
	dec bcnl
	bru bcard0
bcard2:bss 0
	sub bsync,3
	bnz
	bru bcard4
	spb bexit,1
	bcn
	bru 2,1
!!Page 219
	ldx bpoin1,1
	bru 1,1		;and exit
bcard4:bss 0
	sla 1			;Now check for EOF
	bze
	bru bcard3		;EOF on read - set flag and exit
	spb messg,2		;Type out card read error
	dec bcre
	spb bexit,1		;and wait for reader
	ldz
	rcs			;to toggle switch 2
	ext mask6
	bze			;Wait for switch 2 down
	bru 2,1
	ldx bpoin1,1	;toggled
	bru bcard		;So try reading card again
bcard3:ldo
	sta beof		;Set EOF on last read flag
	ldx bpoin1,1	;Get entrance back
	bru 1,1		;and exit.

beofc:bss 0
	lda beof		;Will indicate last card read
	bze
	spb messg,2		;If not read, type out not-ready message
	dec bcnl		;and crump, else just crump
	lda bfflg,3		;Check to see if a back card was found
	bnz
	bru bcback		;No, so make one
	lda fclock+2	;Else see if using Sysout
	cab bno2,3
	bru *+2
	bru beofc0		;No Sysout
	spb bexit,1		;if so, write end-of-file
	bcs btn,1
	bru 2,1
	sel 1
	wef ,7		;Put on an EOF
	bru bcs/o		;and call sysout
	spb time,2
	sta bpdo1,3
	xaq
	sta bpdo1+1,3
	spb messg,2
	dec bpdo
	ldx ovtsk,1
	spb irase,2		;Get rid of this task from list
	ldz
	sta ovtsk
	sta bzyf
!!Page 220
	sta beof
	sta cmessb		;Set batch flag back to zero
	sta io1
	bru 2,1

bno2:	alf NO
bclk:	dec 0			;Used to hold countdown on card reader



,	Exit to start listing of SYSOUT tape
bcs/o:spb irase,2		;Erase present task
	ldx zero,2
	inx s/o,2
	bru pgetb		;and get S/O


bext:	bss 0			;Call in OBA overlay to execute
	inx 1,2		;Get address of parameters to move down
	lda z2
	add bmovp,3		;Set up move
	sta *+2,3
	dld btmov,3
	dec -1		;and move down to T-array
	spb bint,2		;Call in OBA overlay
	alf OBA
btmov:dec t+4
	dec -3		;Move down three parameter words

bint2:bss 0			;Entered for overlays that need options in TY+
	lda 1,2
	sta ty+1		;Get single spca translation message
	inx 1,2		;set to name
,	and continue
bint:bss 0			;Enter here to call peripheral overlay in 1,2
	lda 1,2		;Get name
	sta z0		;save
	ldx ovtsk,1
	spb irase,2
	ldx zero,2
	lda z0		;Search for address
	inx com,2
	cab 0,2
	bru *+2
	bru pgetb		;Get overlay
	inx 3,2
	bru *-4		;Better be in list

.bent.:spb bent,1
	dec -1

!!Page 221
bsync:oct 2606077		;Good card-read sync word
bmovp:z24 0			;Used to construct moves
bfflg:dec 0			;Front card flag, minus 1 if found one
bexit:stx bpoin2,1
	ldx ovtsk,1
	bru 2,1
bcre:	bss 0
	oct 372351
	alf & ER
	alf ROR
	oct 333755
bcnl:	bss 0
	oct 372351
	alf & NO
	alf T R
	alf EAD
	oct 703755

bpnr:	bss 0			;Punch not ready
	oct 374764
	alf NCH
	alf & NO
	alf T R
	alf EAD
	oct 703755

bpdo:	bss 0
	oct 372545
	alf D B
	alf ATC
	oct 306060
bpdo1:dec 0
	dec 0
	alf & & H
	alf OUR
	alf S.
	oct 373755

,	***********************************************
,	Stop at 37677 for catalog

	org t
	bss 4			;Card-type build area
bper:	bss 1			;Put alpha period
bpoin1:bss 1		;Index register storage
bpoin2:bss 1		;Index register storage
beof:	bss 1			;EOF for card read
bbra:	bss 1			;Branch for BAT2

,	Make sure this is at least t+8
bdc:	bss 1			;Batch dump code - 0 for disk handler for tape
!!Page 222
	tcd lovwrt

	stl			;BAT2 - SYM, TYPE, FRONT, BACK, REWIND, SLEW
	ejt
!!Page 223
,	The BAT2 overlay processes standard control
,	cards which would not fit in the batch overlay.
,	When entered the T-array has a branch to the
,	desired routine.
,	Any card input will be in IO1.
,	The tape subroutine is tacked onto the end
,	when this is loaded.

	org pernum
	dec 30
	dec bat2		;Overlay name


	org execov
	dld .baen.,3	;Insert task in list
	spb insert,2
	sta ovtsk		;and save return location
	sta z1
	lda bbra		;Get branch
	sta *+1,3
	nop			;Branch to needed routine

,	Normal entrance to here
baen:	bss 0
	ldz
	rcs
	bmi
	bru 2,1		;If sw-0 down, crump
	lda typf
	bnz
	bru 2,1		;Punt if typing also
	ldx bpoin2,2	;Set up return
	bru 1,2		;and get there

.baen.:spb baen,1
	dec -1
,	Enter on 2
baex:	stx bpoin2,2
	ldx ovtsk,1
	bru 1,2



,	BSYM1 locates symbolic file on tape and
,	positions tape to read after location

bsym1:lda io1+17		;Get handler number
	ext mask3		;extract plug
	add 8K
	sta z1
	lda btab,1
!!Page 224
	sta btmsg1+5,3	;Construct rewind
	add four		;Read four words
	sta bsyex+2,3	;Construct instructions
	spb treqst,2	;Tape subroutine
bsyex:sel 1
	z05 io1		;RTB
	oct 0			;Constructed
	oct 0			;Flag
	spb baex,2
	lda *-2,3		;Check flag word
	bze
	bru 2,1		;Not ready
	bod
	bru *+4
	sra 1
	bod
	bru btmsg1		;End of tape
,	Only other could be EOF so go on.
	ldx zero,1
bs1:	lda io1,1
	cab io1+7,1		;See if match
	bru bsyex-1
	bru *+2
	bru bsyex-1		;No match, try again
	inx 1,1
	bxl 4,1
	bru bs1

,	Check to see if RUN or SYM.  If SYM, go back
,	to BAT.  If RUN call in OBA for tape loader.
	lda io1
	cab bsym2,3		;alf SYM
	bru *+2		;Must be RUN
	bru baret-1		;Close tape then get other ovrlay
	spb tclos,2		;Close tape
	lda btpc,3		;Tape constant for OBA
	sta t+4		;Set in T-array
	ldz
	sta t+6
	sta z2
	inx oba,2		;Get entrance to overlay call
	bru pgetb		;Get overlay

btpc:	oct 20004		;Tells OBA to get tape loader
bsym2:alf SYM

btmsg1:spb messg,2
	dec bet		;End of tape
	spb treqst,2
	sel 1
	z20 --		;Rewind
!!Page 225
	oct 0
	oct 0			;Flag
	bru bartcl		;Close tape and wait for typing

btab:	bss 0
	z21 --		;Make 0 to 4
	z02 --		;[1]
	z04 --		;[2]
	z10 --		;[3]
	z21 --		;[4]
	z22 --		;[5]
	z21 --		;6 to 4
	z21 --		;7 to 4

,	Type routine - entered on reading *TYPE
,	card.  Location 1,1 specifies type or R
,	type and halt - type and halt is on switch 1

btype:bss 0
	lda t+1		;Pick up control word
	sta btypf,3		;Save 0 or minus 1
	lda bacr,3		;Put in EOM character
	sta io1+27
	spb messg,2
	dec io1
	spb baex,2
	lda btypf,3
	bnz
	bru baretw
	ldz
	rcs
	bod
	bru baretw		;Exit to BAT1
	bru 2,1


,	Handle front cards - take necessary action
,	to sign on new user

bfrnt:bss 0
	lda io1		;Get part of user number
	add bo606,3		;Get rid of special characters
	ext bm1,3		;3771717
	bnz			;Give gas
	bru biluse		;illegal user number
	spr irase,2		;Must erase entry before DSKB
	spb time,2		;Get time into type line
	sta bftm1,3
	sta io1+4		;Put on front card
	xaq
	sta bftm1+1,3
!!Page 226
	sta io1+5
	spb messg,2
	dec bftm		;Front card message
,	Write front card on sysout tape
	spb dskb,2		;Find out what tape to use
	spb dskop,2
	z37 1			;Write one record
	dec io1		;From IO1
	z20 bfda,1		;Indirect to front card disk address
	nop
	spb relin2,		;and relinquish disk
	dld zero
	sta bdc		;Initialize dump code
	dst io1-2		;Set start control words
	dld .baen.,3
	spb insert,2	;Get entrance back
	sta ovtsk		;and save place in list
	lda io1+2
	cab bno,3		;alf NO - see if they want sysout
	bru bfrnt1
	bru bfrnt2
	cab bt,3		;See if dump on tape
	bru bfrnt1		;nope
	bru *+2		;yes
	bru bfrnt1		;nope
	lda bhan7,3		;On sysout tape
	sta bdc
bfrnt1:spb treqst,2
	sel 1
	wtb io1-2,7		;Use tape 7
	    %29
bfrntf:oct 1			;Flag - initialize to done
bfrnt2:spb bpwt,1		;Wait for punch
	wcd io1
	spb bpwt,1
	spb bafx,2
	lda bfrntf,3	;Wait for tape before exiting
	bze
	bru 2,1		;Not done
	bru bartcl
bftm:	bss 0
	oct 377777
	alf ON
	alf AT
bftm1:dec 0
	dec 0
	oct 375577

bno:	alf NO		;For  sysout
bt:	alf T			;For tape dump
bhan7:oct 3000000		;Handler bits for tape seven
!!Page 227
bo606:oct 606
bm1:	oct 3771717


,	Illegal user number, type message and wait
,	for 19 to be toggled.
biluse:spb messg,2	;user.
	dec bilusm
	spb baex,2		;Get out
	ldz
	rcs
	bev
	bru 2,1		;Not yet
	spb baex,2
	ldz
	rcs
	bod
	bru 2,1
	rcd io1
	hcr
	spb baex,2
	bcn			;Wait to get in
	bru 2,1
	bru bfrnt		;and start over


bilusm:oct 376462
	alf ER.
	oct 375577




,	Handle back card - sign user off

bback:bss 0
	spb irase,2		;Erase entry so can use the disk
	spb dskb,2		;Ask
	spb dskop,2		;Read
	z12 1
	dec fclock		;into 600
	z20 bfda,1		;Indirect to address
	nop
	spb relin2,		;Get rid of disk
	dld .baen.,3
	spb insert,2	;Get entrance back
	sta ovtsk
	lda fclock+2	;See if using sysout
	cab bno,3
	bru *+2
	bru bback3		;No, so skip
!!Page 228
	spb treqb,2		;Yes, so terminate
	sel 1
	wtb bs/of1,7	;Write ending record
	    %29
bback2:oct 1		;Initialize to done
bback3:spb time,2
	sta bbkm1,3
	xaq
	sta bbkm1+1,3
	spb messg,2
	dec bbkm		;Back card message
	spb bpwt,1
	lda bbwd,3
	sta io1
	dld bamov,3
	mov io1
	wcf io1
	spb bpwt,1		;Wait for punch
	ldz
	sta io1		;Look for front card
	spb baex,2
	lda bback2,3	;See if tape done
	bze
	bru 2,1		;No
	bru bslew		;and slew to top to terminate

bs/de1:oct 20		;Control words for end of file
	oct 0
bbwd:	oct 4001		;Used to punch back card
bbkm:	bss 0
	oct 377777
	alf OFF
	alf & AT
	oct 607777
bbkm1:dec 0
	dec 0
	oct 375577

bpwt:	bss 0
	stx bpoin1,1	;Save return
	spb baex,2
	bpn
	bru 2,1		;and if punch not ready, continue to crump
	ldx bpoin1,1
	bru 1,1		;and return


,	Rewidn any tape except 0

brwnd:bss 0
	lda t+2
!!Page 229
	sra 12		;Right-justify handler
	ext mask3		;Get rid of high order
	add 8K
	sta z1
	lda btab,1		;Get handler code
	sta brwndh,3
	spb baex,2
	bcs btn,1
	bru 2,1
	sel 1
	z20 --		;Rewind
brwndh:oct 0
	spb baex,2
	bcs btn,1
	bru 2,1
	spb baex,2
	bcs brw,1
	bru 2,1
	bru baret


,	Slew to top of page

bslew:bss 0
	spb baex,2
	bcs bpn,6
	bru 2,1
	sel 6
	slt 8
	spb tclos,2		;Close out tape
	bru baret1		;Leave io1 alone this time

btypf:dec 0			;Set to indicate type and halt or type no halt

bamov:dec io1+1		;Constants to clear punch area
	dec -79
bacr:	oct 375577

,	Call batch ovrlay back
	spb tclos,2		;Close tape
baret:bss 0
	lmo
	sta io1		;Set front card in flag
baret1:ldx ovtsk,1	;Erase entry to this overlay
	spb irase,2
	ldx zero,2
	inx batch,2
	bru pgetb		;Bring in overlay


!!Page 230
bartcl:spb tclos,2	;Close tape and then wait for typing
,	Wait for typed message and then call batch
,	back in
baretw:bss 0
	spb baretx,2	;Type fudge
	lda typf		;Type flag
	bnz
	bru 2,1
	bru baret
	ldx ovtsk,1
	inx 1,2
	stx bpoin2,2
	bru 2,1		;Exit so typf can get set


bet:	bss 0			;End of tape
	alf END
	alf & OF
	alf & TA
	alf PE.
	oct 375577

bfda:	oct 3400		;Disk address for batch front card

,	Set up a couple disk addresses and pull in tape
,	subroutine

	loc 6000
b2fix:ldx 8K,3
	lda tap+2		;Get tape subroutine on end
	sta b2fix2
	bcs brn,0
	bru *-1
b2fix1:sel 0
	pwf ,0
b2fix2:oct 0		;Disk address filled in
	bcs brn,0
	bru *-1
	sel 0
	rrd 3
	    %treqst
	bcs brn,0		;Wait
	bru *-1
	bcs ber,0		;Check for errors
	bru b2fix1
	bru lovwrt		;and load

	tcd b2fix

	stl			;Batch temporary storage
	ejt
!!Page 231
xr312:equ 126		;Register for trap save


	loc 216
otmp:	bss 1			;API
odret:bss 1			;ODDP, OTTIM
	loc 230
odret2:bss 1		;Index register storage for SYSOUT, ODSK
otmp2:bss 1			;OSOTER, OTRAP, ORTRAP
otmp3:bss 1			;OTYPE
otemp:bss 1
otmp1:bss 1
,	End API area definitions


	stl			;Batch part 1
	ejt
	org pernum
	dec 32
	dec oba
	org execov
,	********************************************

,	    This overlay is called in by the -BAT-
,	overlay whenever there is a call to run a
,	background program which destroys the time-
,	sharing executive.  [sacre bleu.....]
,	    The overlay has four possible entrances.
,	 1) 37000 - overlay entered here when first
,	loaded by 235 exec, then never entered here
,	again.
,	 2) 37001 - entered here by the running
,	system upon completion of the entire
,	run, or to begin the execution of a disk,
,	tape, or typing operation by the executive.
,	3) 37002 - entered here by exec whenever
,	exec is loaded into memory, and OBFLG (in
,	the bootstrap) is not zero.
,	 4) 37003 - enter here when permission has
,	been granted by the D-30 to run a background
,	system.

	bru oinit		;Enter here from exec, first time
	bru osys		;Enter here from calling system
	bru ores		;Enter here from exec on reset
	bru orun		;Enter here from 235 exec on run from D-30

,	    ORUN is entered at any time the D-30
,	gives a run-batch message to the 235 exec.
,	The result of this may be the initial running
,	of a batch task previously set up, or the
,	restoration of an OLD problem previously run.
,	In any case, the following things happen...
,	 1) If switch 0 is down, the batch job is
,	    punted until next time around.
,	 2) If the 235-exec us typing a message,
,	    again, the run time is punted.
,	 3) If the tapes are not ready after a reason-
,	    able amount of time, or there is an error,
,	    this batch period is punted.
,	 4) The interrupt branch is stolen from the
,	    235 exec, and given to this overlay.

,	    If this is a run being brought in for the
,	first time, the previously constructed
,	load sequence is executied to bootstrap the
,	system in, and control is transferred to it
,	in index-group 0, non-trpmode, pst, binmode
!!Page 233  10/13/02
,	and kon.

,	    On reloads of jobs peviously running,
,	the following conditions are restored - 
,	A. Arithmetic mode [AAU]
,	B. Binmode or Decmode
,	C. AX, QX, A, Q
,	D. Index group
,	E. Overflow
,	F. Kon is set (it should never be off)
,	G. Non-trapping mode is set (never on I hope)
,	H. A set prq is executed to start
,	   peripheral tasks going again
,	         .....and then back to the program.



orun:	bss 0

	lac			;Set run+swap time counter
	sta otim1t,3
	ldz
	rcs			;Check switch 0 - if down, punt
	bmi
	bru onrun		;punt
	lda typf		;See if 235 typing
	bnz
	bru onrun		;If so, punt
	dld bsums2,3	;Move summary up
	mov fkedit
	lda offlg,3		;Now check for initial or rerun
	bze
	bru orunf		;First run to be executed
	ldo
	sta cmessb		;Just in case of bootstrap
	spb oload,1		;Load in the damn program from storage
	lda oapib,3		;Get API branch instruction
	sta z2+2		;and put where API branch will be to
	lda oarr+4,3	;Pick up save xr1 contents
	sta otmp		;and put where routine will restore them
oruna:set ntpmode		;spb ortrap,1 if necessary
	fld oarr+2,3	;Reset AAU registers
	xaq ,A
	fld oapr,3
	kon			;Just in case
	lac
	sta otim2t,3
	set prq		;Set prq - to get things going
orung:bru *
orunm:bru *
	bru oint2		;Go to normal restore sequence

	stl			;Batch part 1 - load
	ejt
!!Page 235
,	********************************************
,	OLOAD determines whether the program was
,	dumped on tapes or the disk and then loads
,	correctly.
,	Disk dump - four 4K blocks
,	Tape dump - lower memory on tape, upper on
,	            disk

oload:spb odask,2		;Always need disk
	lda opar,3		;See where dump is
	bze
	bru oload0		;Disk
	spb otop,2		;Tape
	oct 1517777		;Read backwards
oltc:	oct 0017550
	bru oload1		;Get upper memory from disk
oload0:spb odop,2		;Lower memory
	z12 2
	dec 0
	oct 24100		;Disk address
	spb odop,2
	z12 62
	dec 256		;Read into wrong place
	oct 24104		;From right place
	spb odskwt,2	;Wait to get in
	dld damov,3		;move down
	mov 256+24
	spb odop,2
	z12 64
	dec 4096
	oct 24500
,	Upper memory
oload1:spb odop,2
	z12 64
	dec 8192
	oct 25100
	sob odop,2
	z12 56
	dec 12288
	oct 25500
	lda opar,3
	bze
	bru oload2
	spb otop,2
	z15 127		;Get rest of tape
oltc2:dec 129		;Set busy flag
	spb otop,2		;Wait for tape
	dec 0
oload2:spb orflin,2	;Get rid of disk
	bru 1,1		;and return

!!Page 236

,	********************************************

onrun:bss 0			;Entered if for some reason a -RUN BATCH-
,	permission message is to be temporarily
,	ignored, an immediate return to time-
,	sharing is desired


	lda otwo,3		;Just tell D-30 to resume normal T-S
	sta mbx0
	bru iplst		;and go to peripheral task list
,	********************************************

,	***Typed message will be put here****

orunf:bss 0
	lda oapib,3		;Get API branch
	sta z2+2
	lac
	sta otim,3		;Set run start time
	sta obzyf,3		;Set to busy
	ldo
	sta offlg,3		;Set not first entrance flag
	spb odask,2		;Get disk from D-30
	spb odop,2		;Bring in 35000 and 36000 parts of BATCH
	z12 16
	oct 35000		;Memory address to read into
orunf.:oct 0		;Filled in when loaded
	ldo
	sta cmessb		;Reset+
	spb odskwt,2	;Wait for disk to finish
	dld orun.2,3	;Move trap routines where they belong
	mov osbu1
	bru orun.3		;and go finish this there

orun.2:dec ortrap
	dec -128

	org orun
	bss 31		;Save space for typed messages

	stl			;Batch part 1 - tape routines
	ejt
!!Page 237


otop:	bss 0			;Tape operations
	stx odret,2		;Save index before tape waiting
	spb otapwt,2
	ldx odret,2		;and get it back after wait
	lda 1,2
	bze
	bru 2,2
	sta otp2,3
	lda 2,2
	sta otp2+1,3
	sel 1
otp2:	dec -
	dec -			;***
	bru 3,2		;and return


otapwt:lda o8K,3
	sla 2			;Get a reasonable countdown value
	bcs btr,1
	bru 1,2
	sbo
	bnz
	bru *-4
	spb otyp,2		;Type out message
	dec otem		;Alert halt on tapes
	bru ostop0		;and punt run
,	********************************************
,	    The following routine picks up tape
,	commands from tp2 and tp2+1,
,	constructs correction commands for each type
,	of operation, and executes these instructions
,	assuming the tapes are ready on entrance.
,	 On forward reads, a backwards read in the
,	same mode is constructed.
,	 On backwards reads, a forward read in the
,	same mode is constructed.
,	 On write instructions, a BKW is contructed.
,	     These routines are based on the
,	following characteristics of the GE tape
,	instructions.
,	Bit 1 on always means backwards tape movement
,	Bit 2 on always means a read operation
,	Bit 3 on always means a write operation.

oter:	bss 0

	lda otp2,3
	srd 16		;BKW, EKT, RWD, WEF.
	bod			;Check bit 3
!!Page 238
	dld othree,3	;Pick up words which will give BKW
	srd 2			;Now check for foward or backwards
	ado			;Else construct backwards
	sld 18		;Get the instruction back
	sta oter2,3		;and put in correction sequence
	lda otp2+1,3
	ext otmsk,3		;and make it a zero word count
	sta oter2+1,3	;and put away
	sel 1			;and execute correction instruction.
oter2:dec -
	dec -
	bru 1,2		;and return
otmsk:oct 0077777		;Mask to extract word count from tape command

	stl			;Batch part 1 - disk routines
	ejt
!!Page 239
,	********************************************
,	    ODOP is the disk operation subroutine
,	for the overlay.  It serves both the executive
,	and user's programs, but must be called
,	only while in an API program.  The calling
,	sequence is -
,	      spb odop,2
,	      rrf (or wrf), x records, less than 97.
,	      memory address for read or write
,	      oct position on disk for read or write
,	      return location.

,	There is not, at the moment, any provision
,	for indirect addressing of the parameter
,	list.  In addition, the D-30 should already
,	have been asked for the disk, and this
,	routine does not relinquish the disk when it
,	is through.  [JSM: code reads otherwise]
,	the disk is not checked for error on
,	entrance, nor does it check on the last
,	operation it executes (because it exits
,	before it is done).  On intermediate errors,
,	it tries 5 times, and then returns an
,	error message.  Three error types are checked
,	1 - disk not ready
,	2 - illegal addres on disk
,	3 - parity error on read or write.
!!JSM: Correction: added line below based on code.
,	4 - illegal disk address
,	These are all indicated by a positive
,	number in the A register on return, else A
,	will be zero.

odop:	bss 0
	ldz			;Zero odcnt just in case
	sta odcnt,3
	stx odret,2		;Save entrance register
	lda 3,2		;Pick up the disk address
	sta z2		;Indirect if word is minus
	bmi
	lda 0,2
	sta odseek+2,3	;Put it away in case it is legal
	ext omsk2,3		;check for legal position address
	sub oo300,3
	bpl
	bru odker		;Illegal address
	lda odseek+2,3	;Get disk address back and store for relinqsh
	sta orelad,3	;Store disk address for the relinquish
	spb odskwt,2
odseek:sel 0		;Seek command
	prf ,0		;***
	oct 0			;***
!!Page 240
	ldx odret,2		;Restore entrance register
	lda 1,2		;Get RRF-WRF-WRD-RRD-
	sto odcnt,3		;Save record count
	ext omsk1,3		;Now punt record count
	add odinst,3	;Set up proper instruction
	sta odoper+1,3	;Put it away
	lda odcnt,3		;Now compute bit setting for 96-record RW
	srd 4
	xaq			;Remainder mod 16 in A
	sra 15		;Position remainder...if zero
	bze			;want 16 in A and 1 less in Q
	dad ofudge,3	;OFUDGE = 15, -1
	ory odoper+1,3	;Put it away
	ldz			;Now set bits 2-4
	scd 4
	add 2,2		;Add the memory address
	sta odoper+2,3	;Put it away
odoper:sel 0		;Execute the instruction
	z00 0			;***
	z00 0			;***
	ldz
	bru 4,2		;Return to caller
ofudge:dec 15
	dec -1
,	********************************************
,	Wait for disk - if ready exit immediately,
,	if not, wait awhile, then see if can ask D-30
odskwt:bss 0
	lac
	add oseven,3
	sta odival,3
odskw0:bcs brr,0
	bru 1,2
	lac
	cab odival,3
	bru odskw0
	bru odskw0
	add oo40,3
	sta odival,3
	stx odret2,2	;Disk not ready so type message
	spb otyp2,2
	dec odnr		;Disk not ready
	ldx odret2,2
	bru odskw0		;Keep trying to get disk



odker:spb otyp,2		;Give illegal address message
	dec oiad
	lda ofour,3		;Pick up error indication
	ldx odret,2		;Get return address
!!Page 241
	bru 4,2		;Error exit, code in A register

,	********************************************
odask:bss 0			;Disk Request routine - ask D-30
	ldo
	sta pmbx0
	lda pmbx0
	bpl
	bru *-2
	bru odskwt		;Now wait for ready


,	********************************************
orelin:bss 0		;Disk relinquish - enter on xr2
	stx odret,2		;Save index register for wait
	spb odskwt,2
	ldx odret,2
	ldo
	ory orelad,3
	sel 0
	prf ,0		;Position on last operation
orelad:oct 0		;***
	bcs brn,0
	bru *-1
	sel 0
	oct 1213040		;Read-after-write - 0 records
	oct 0
	lda otwo,3		;Send - can-have-disk message -
	bru ospmb		;and set message and will bru 1,2

	stl			;Restore after dump
	ejt
!!Page 242


,	********************************************
,	    ORES is entered after every reload of
,	the 235 exec by this overlay.
,	It does six things-
,	1) Sets the busy flag BZYF to busy
,	2) Sets CMESSB - the batch flag - to BATCH mode
,	3) Tells D-30 it can have the disk.
,	4) Tells D-30 to resume normal time-sharing
,	5) Checks to see if the last program ran to done
,	6) Checks to see if exist was to type message.
,	   It then exits back to the 235-exec.


ores:	bss 0
	spb irase,2
	lac
	sub otim1t,3
	add otim1,3		;Accumulate running plus swap time
	sta otim1,3
	lda otwo,3		;******yes - maybe ***
	sta mbx0		;Tell D-30 to resume normal time-sharing
	ldo
	sta cmessb		;and set cmessb non-zero
	sta bzyf		;and same for busy flag
	lda ofour,3		;Tell D-30 to start counting time
	spb ospmb,2
	ldz
	sta otypf,3		;Set type flag to 0 for next entry
	lda otad,3		;Check for message to be typed
	bnz			;if there is an address
	spb messg,2		;go to 235 and type it
otad:	dec 0			;Address of any typed message goes here.
	dld .ors2.,3
	spb insert,2
	sta ovtsk
	lda obflg,3		;See if terminal
	bze
	bru 2,1		;No
ors0:	lda osrat,3		;Give D-30 a crump-batch message
	spb ospmb,2
	bru orst		;and get out
ors2:	bss 0
	lda typf
	bnz
	bru 2,1
	ldz
	sta otad,3		;Crump typewriter task
	bnr
	sna 19		;and check for STOP message
!!Page 243
	sub ost,3
	bnz
	bru *+4
	ldo			;Set up to look for BACK card
	sta io1		;and crump since S was typed
	bru ors0		;Crump - somebody typed -S-
	lda obflg,3		;Now check for entered on completion
	bze
	bru 2,1
orst:	bss 0			;Stop whole operation
	lda otim2,3		;Real running time
	spb ogtim,2		;Convert
	dec otimr
	lda otim1,3
	sub otim2,3		;Get swap time
	spb ogtim,2
	dec otims
	lac
	sub otim,3		;Get total time on machine
	spb pgtim,2
	dec otimo
	ldx ovtsk,1
	bcs bpn,6
	bru 2,1
	sel 6
	slw 4
	lda .orst1,3	;Change branch
	sta 0,1
orst1:lda typf
	bze			;Wait for alert halt message
	bcs bpn,6
	bru 2,1
	sel 6
	wpl otiml
	ldz
	sta obzyf,3		;Reset
	spb irase,2		;Erase this entry to task list
	spb dskb,2		;Get disk
	spb dskop,2		;Disk operatin
	z37 8
	oct 37000		;Dump from 37000
	oct 25600
	nop			;Error return
	spb relin,2		;and get rid of disk
	lda opar,3		;Get dump code
	sta bdc		;save for next part, if any
	ldx zero,2
	inx batch,2		;Call in batch overlay
	bru pgetb		;Overlay caller in exec
!!Page 244

ogtim:bss 0			;Convert time to decimal
	stx z0,2		;Save calling register
	maq			;and conversion
	lda 1,2		;Pick up where to put away
	sta z2
	ldz
	dvd h1		;52140 [21600 = 3600*6]
	spb obcd,1
	sta 0,2
	ldz
	dvd h2		;550 [360 = 60*6]
	spb obcd,1
	sta 1,2
	ldz
	dvd six
	spb obcd,1
	sta 2,2
	ldx z0,2
	bru 1,2

obcd:	bss 0
	dst oaq,3
	maq
	dvd ten
	sla 6
	sta oaq,3
	xaq
	add colon
	ory oaq,3
	dld oaq,3
	bru 1,1


otiml:bss 0			;Line for time printout
	alf & TO
	alf TAL
	alf & TI
	alf ME
otimo:dec 0			;Actual on-to-off time
	dec 0
	dec 0
otimt:oct 373751
	alf UNN
	alf ING
	alf & TI
	alf ME
otimr:dec 0			;Actual computer running time
	dec 0
	dec 0
	oct 375562
!!Page 245
	alf WAP
	alf & TI
	alf ME
otims:dec 0			;Swap time
	dec 0
	dec 0
	alf .
	dec -1		;Print line delimiter

	stl			;Batch part 1 - initialization
	ejt
!!Page 246

,	********************************************

,	OINIT is entered after the batch overlay
,	discovers a time-sharing-destroying system is
,	to be run.  It expects to find the
,	following information left in the array -T-
,	T   = Alphanumeric -RUN-
,	T+1 = xxx
,	T+2 = xxx
,	T+3 = Alphanumeric system name
,	T+4 = 0, 4, 10...code for loader type plus
,	      8K bit on in word.
,	       0 is standard disk image loader
,	       4 is bridge-type tape loader
,	      10 is blocked disk loader
,	      14 is binary card loader

,	T+5 = octal disk address, of the first
,	      program record - used by loader
,	T+6 = 0 if system is to be dumped
,	      intermediately on disk.
,	    = octal handler configuration if
,           system is to be dumped on tape.

,	OINIT will insert the handers where they
,	belong, set up the sequence to load the
,	loader, set up the D-30 start-batch message,
,	and exit to wait for a begin-batch message.

oinit:bss 0

	lda obbru,3		;Pick a bru 1,1
	sta execov,3	;Preset API exit to no action
	lda pmbx0		;See if have an unanswered message
	bpl
	bru *-2		;yes
	lda oten,3		;Ask D-30 to initiate batch mode.
	spb ospmb,2
	bru 2,1		;and return immediately to exec.


,	********************************************
ospmb:bss 0			;Sends special mailbox message to D-30
	sta pmbx0
	lda pmbx0		;and waits for an answer
	bpl
	bru *-2
	bru 1,2


!!Page 247
,	********************************************
otyp:	bss 0			;Entered internally to set up typed message
	lda 1,2
	sta otad,3		;Put in message adddress
	bru 2,2		;and exit

	stl			;Constants and things
	ejt
!!Page 248
,	Constants and flag storage
odival:bss 1
odcnt:dec 0			;Count disk records - must be initally 0
.ors2.:spb ors2,1
.orst1:spb orst1,1
oo40:	oct 40
	oct 2000
,	Running time constants
otim:	dec 0			;Will hold total real time for job
otim1:dec 0			;Will hold actual running time
otim2:dec 0			;Will hold running time + swap time
otim1t:dec 0		;Temporary accumulator for otim1
ptim2t:dec 0		;Temp. accumulator for otim2
,	End time holders
oseven:dec 7
omsk1:oct 77777
omsk2:oct 3777400
odinst:oct 10040
oo300:oct 300
ost:	alf 00S		;OPSTOP message on typewriter
oent1:equ execov		;User's branch put here
osbat:oct 11		;Stop-batch to D-30
oaq:	dec 0			;A and Q storage
	dec 0
othree:oct 3		;Constant
ofour:oct 4			;Constant
otem:	oct 376321		;Tape alert.
	alf PE
	alf ALE
	alf RT.
	oct 375577
o8K:	dec 8192
oti:	equ o8K
odi:	equ o8K
obflg:dec 0			;Flag 0 = no special circumstances
,	           1 = job ran to completion
omop:	z24 0			;Move opcode, used in overlay call routine
offlg:dec 0			;First run flag
otwo:	oct 2			;Constant
opar:	dec 0			;Save disk-or-tape flag here
odec:	dec 0			;Error count of diskp
oiad:	bss 0			;Illegal disk address
	oct 312155
odnr:	bss 0			;Disk-not-ready message
	oct 244255
otypf:dec 0			;Signals type of entry to OBA

,	     ODAD is a table of parameters for
,	the various types of loaders it is possible
,	to call during batch.
,	     Each entry is three words long,
,	consisting of the disk address and read
,	commands for this loader.  It is assumed
,	that the first memory location for the
,	loader is the first program location and
,	entrance point.

odad:	bss 0			;Table of disk loader parameters
	z12 6			;Disk card image loader
	oct 35000		;into 35000 in memory
	oct 32000		;from this disk address
	dec 0
	z12 3			;Bridge-type tape loader
	oct 17500		;into memory at 17500
	oct 32010		;from this disk address
	dec 0
	z12 7			;Blocked disk loader
	oct 17000
	oct 32020
	dec 0
	z12 7			;Card loader
	oct 35000		;memory address
	oct 32030		;into memory from this disk address
	dec 0
	bss 0			;End of catalog
oten:	oct 10
otwen:oct 20
oapib:bru oint,3		;Steal API branch from exec to run
oamov:z00 128+24		;Used to move disk records down to API area
	dec -3948		;a few too many makes no difference

	stl			;Batch part 1 - Tape correction for hard error
	ejt
!!Page 250

,	This routine is entered from the tape routine
,	after it has tried the operation five times
,	and still gets an error indication.
,	If the operation was a write it will erase
,	tape and re-write the record.
,	If the operation was a read it will try
,	switching modes and re-reading.  If that does
,	not work it will return to the original mode.
,	It punts if it finds a read special.

otera:lda otpb,3		;Get bad tape command
	srd 16		;Check bit three - if on it was a write
	bod
	bru otera1		;So erase
,	Instruction was a read so change modes
	bmi
	bru otwrp2		;Was a read-special so punt
	lda oswc,3		;3-way flag 0 - first entrance, minus -
,	second entrance, plus - third (and final) entrance
	bnz			;Set flags for next time
	bru *+3
	lmo
	bru store
	bpl
	bru otwrp2		;Last time so punt
	ldo
store:sta oswc,3
	lda otpb,3		;Get bad tape command
	srd 15
	bev
	ado
	ext otwo,3		;Wipe out bit 18 - now we have the changed
,	instruction
	sld 15		;Put insruction back together
	sta otlst,2		;put back in list
	ext otmsk,3		;77777
	add oten,3		;Get proper error bit on
	sta otst,3
	spb oter,2		;Back up tape
	lda oseven,3	;Reset error count to seven
	sta otec,3
	bru 1,1		;Exit and try again

oswc:	dec 0

,	Command was write so erase
otera1:lda otpb,3		;Get command back
	sta otlst,2
	spb oter,2		;Back up tape
	lda oter2+1,3	;Get handler information
!!Page 251
	add oo2476,3	;Erase at least 2476 words
	sta otap1+2,3
	lda otap1.,3	;spb otap1,1
	sta oint2+1,3	;Fudge branch
	bru 1,1
otap1:spb otop,2
	ert ,4		;Will be changed
	    %0
	lda otape.,3	;spb otape,1
	sta oint2+1,3
obbru:bru 1,1		;Exit - also constant to set API branch
otap1.:spb otap1,1

bsums:bss 8			;Space for summary

bsums2:dec bsums		;Constant to move summary up
	dec -8
otape.:spb otape,1

	loc 37777
obzyf:dec 0			;Busy flag in case of bootstraps


	loc 6000
obaf1:ldx 8K,3
	lda oba3+2
	sta orunf.,3	;Initialize disk address
	bcs brn,0
	bru *-1
obaf2:sel 0
	prf ,0
	oct 26160		;Put on dump part
	bcs brn,0
	bru *-1
	sel 0
	wrd 8,0
	    %execov
	bcs brn,0
	bru *-1
	bcs ber,0
	bru obaf2
	bru lovwrt

	tcd obaf1

	stl			;Batch part 2
	ejt
!!Page 252

,	Information for 235 loading routine
	org pernum
	dec 34
	dec oba2		;Overlay name
	loc 36000		;Lower memory part of batch overlay


,	This entrance must remain at 36000 to be
,	entered from the loader.
	sxg 2			;Call in OBA3
	ldx z2+1,3
olobar:lda otwo,3
	spb exec,1
	dec oloba3
	lda oloba3+3,3
	bze
	bru *-2
	bev
	bru olobar		;Error, try again
	sxg 0
	bru 0,3		;Go to program
oloba3:z12 8		;8 records
	oct 35000
	oct 0			;Filled in when loaded
	oct 0

	stl			;Program exits
	ejt
!!Page 253

,	    OSYS handles entrances from user programs.
,	It is the only part of the overlay which is
,	executed outside of API, and may be interrupted.
,	It may be entered in any index group, stays
,	there, and very well may destroy said index grp.
,	There are five possible entrances, according,
,	to the contents of the A register.

,	Codes are as follows
,	0 = Termination
,	1 = Tape operation
,	2 = Disk operation
,	3 = Typewriter output
,	    sign on is type and crump
,	4 = overlay or new system call.
,	5 = Sysout write, sign on if indirect



osys:	bss 0
	sta otemp		;Construct a branch pointer
	ldx otemp,2		;from calling routine
	inx -1,2		;[make zero also an error]
	ldx z2+1,3		;Get 8K into xr3
	set pst		;Just in case some dummy.......
	bxh 8,2		;Check for legal calling number
	bru oterm		;and if it isn't, crump the bum
	bru *+1,2		;Branch according to calling value
	bru otap		;1 = tapes
	bru odsk		;2 = disk operation
	bru otype		;3 = type routine
	bru oovr		;4 = overlay call
	bru oso		;5 = sysout
,	6 and 7 are reserved for special messages to
,	the D-30
	bru oterm
	bru oterm
	bru oitrap		;10 = Start trap restore

	stl			;Interrupt routine
	ejt
!!Page 254

,	********************************************
,	    This is the entrance for API interrupts
,	during the running of a background system.
,	Interrupt branches are set up whenever the
,	overlay gets word to run the background
,	system.
,	On interrupt, the routine has one definite
,	task, and three possible tasks.

,	A) It checks the mailbox for a stop running
,	   batch message.  If there is such, it dumps
,	   the system and takes necessary action to
,	   restore normal time sharing.
,	B) If there are any disk operation to be
,	   done, or just completed, they are executed.
,	C) If there are tape operations to be done,
,	   or completed, they are taken care of.
,	D) The overlay checks to see if the running
,	   system wants to execute an API program, if
,	   so it branches to it.

,	The interrupt routine assumes 8K in xr3 of
,	interrupt group.

oint:	bss 0			;Enter overlay here on API interrupt.

	dst oaq,3		;Save A and Q
	set binmode		;Will restore it to decmode if needed
	hcr			;Just on general principles
	stx otmp,1		;Save index register for return
	lda mbx0		;Check for D-30 dump command.
	sub odmp,3		;octal 11 - dump batch message.
	bnz
	bru oint2		;No dump message from the D-30
	sta mbx0		;Answer D-30 dump command
	bru odump		;and exit
oint2:bss 0			;May return here
	spb odisk,1		;Check to see if there are disk commands to be
,	      executed
	spb otape,1		;Check to see if there are tape commands to be
,	      executed
	ldz			;Check typewriter input
	bnr			;If an -S- is input, it is command to stop
	sna 19		;Pick up N-reg character
	sub ost,3		;Subtract BCD -S-
	bze
	bru ostop-2		;Stop program and look for back card
	sbo			;See if T
	bze
	spb ottim,0		;Output running time
!!Page 255
	spb oent1,1		;Execute user's API program, if any
	lda otypf,3		;Pick up type-of-entry flag.
,	0 means not special
,	1 means type message to be set up
,	  also dump for overlay
,	2 means terminal dump entrance
	bze
	bru otin3		;No task assigned by this flag [value]
	bod
	bru odump		;Dump in order to type out message........
	bru ostop		;Terminal exit so do it
otin3:ldz			;Check console switches, and if no good, punt
	rcs
	bmi
	bru odump
	ldx otmp,1		;Get return register
!!Bit positions 0-4 of the return address contain
!!indications of the machine's prior state...
!!Bit 0 - KON in effect
!!Bit 1 - TON in effect
!!Bit 2 - BCD remebered carry on
!!Bit 3 - DECMODE in effect
!!Bit 4 - Overflow indicator on
	lda otmp
	bov			;Reset overflow if on
	bru *+1
	sla 1			;and start restoring
	bov
	ton			;Bit one
	sla 1
	bov
	bru *+1		;Ignore DECMODE carry
	sla 1
	bov
	set decmode		;[Bit 3]
	sla 1			;[Bit 4 restore overflow indicator]
	dld oaq,3		;conditions
	set pst		;before
	bru 0,1		;returning

	stl			;Batch part 2 - Tape set-up
	ejt
!!Page 256
,	********************************************
,	    OTAP is entered to place a tape command
,	into the command list.  The commands must be
,	in the format given in subroutine OTAPE, and
,	are never checked for validity.
,	The index group entered on is destroyed, with
,	the exception of xr1.
,	The flag words is set to 0 before exiting.  If
,	the list is full, the routine waits until
,	it can insert the task before exiting.

otap:	bss 0

	lda oto,3   	;Pick up pointer to tape task list
	sta otemp
	ldx otemp,2		;Get pointer to tape list in xr2
	lda otlst,2		;and check for room in task list
	bnz
	bru *-2		;No room - so wait until there is.
	lda 1,1		;Pick up pointer to tape op
	stx otemp,1
	bpl
	bru otap0		;Indirect
	inx 3,1		;Set for return, direct
	lda otemp
	ado			;Get address correct
otap0:sta otemp		;  and then
	ldx otemp,3		;    put in xr3 and
	sta otlst+2,2	;    tape task list
	ldz			;Zero the task done flag in user's param list
	sta 3,3
	lda 2,3		;Store tape command
	sta otlst+1,2	;  in
	lda 1,3		;    the
	sta otlst,2		;      tape task list
	ldx z2+1,3		;Restore up8 bit to xr3
	inx 4,2		;Bump up list pointer
	stx otemp,2
	lda otemp		;Get list pointer back and reset
	bxh 16,2		;Check for wraparound = 4 entries
	lda oti,3		;Wrap around
	sta oto,3		;and put away the pointer
	set prq		;set prq in case nothing in operation
	bru 2,1		;Return to the user's program

	stl			;Disk set-up
	ejt
!!Page 11319
,	********************************************

,	    ODSK is entered to insert parameters in
,	the disk task list.  An internal wait is
,	made for an opening list location.  Scratch
,	disk areas are assigned here.

odsk:	bss 0
	stx odret2,1	;Save entrance
	lda odo,3		;Get pointer to task list
	sta otemp
	ldx otemp,2
	lda odlst,2		;See if entry available
	bnz
	bru *-2
	lda 1,1		;Entry now available
	sta otemp
	sta odlst+3,2	;so get pointer to parameter list
	ldx otemp,1
	ldz			;Set flag-word to zero for user
	sta 3,1
	lda 1,1		;Will be memory address for read or write
	sta odlst+1,2
	lda 2,1		;Get PRF
	bpl
	bru odsk2		;Address given, no scratch area request
	lda odsa,3		;Get pointer to scratch list
	sta otemp
	ldx otemp,3
	lda odsl,3		;Get next address from task liust
	bze			;If zero - end of list
	bru odske		;so give error exit
	inx 1,3		;Set up pointer to get next entry next time
	stx otemp,3
	ldx z2+1,3		;and restore 8K to xr3
	sta odlst+2,2	;Put address in command list
	sta 2,1		;and also return to exec
	lda otemp		;Now get pointer to scratch list
	sta odsa,3		;and put it back
	bru odsk2+1		;and jump around normal put-away
odsk2:bss 0
	sta odlst+2,2
	lda 0,1		;Will be RRF or WRF
	sto otemp		;and get record count to be processed
	ldx otemp,0
	bxh 97,0		;Disallow anything over 96
	bru odske		;Go set too-many-records flag
	sta odlst,2
	inx 4,2		;Else bump pointer and exit
	stx otemp,2
	lda otemp
!!Page 258
	bxh 16,2		;End of list if so
	lda odi,3		;so re-initialize
	sta odo,3
	set prq		;set prq in case nothing going

odskx:ldx odret2,1	;Get return back
	bru 2,1		;and go back around address word
odske:ldo			;Set too-many-records bit on
	sla 19-2		;Task list stays zero
	sta 3,1		;Flag location
	bru odskx

	stl			;Type routine
	ejt
!!Page 259
,	********************************************
,	   OTYPE makes it possible for user programs
,	to type out messages without use of normal
,	time-sharing time, and without having the
,	message garbled by intervening interrupts.
,	When a type command is given, the program is
,	immediately dumped, and not reloaded until
,	the message has been typed out.
,	   The calling aequence for the type routine
,	is as follows -
,	   lda three
,	   spb type,1 = 37000
,	   dec message location


otype:bss 0

	bpl
	bru otype1
	stx otmp3,1		;Save entrance register
	sta io1		;Have front
	spb osoter,1	;Terminate sysout buffer
	ldo			;Set up to crump after message
	sta obflg,3
	ldx otmp3,1		;Get it back
	lda 1,1		;move message-to-be-typed to exec
	add omop,3		;Z24
	sta *+2,3
	dld omtex,3
	mov 0
	lda oeom,3
	sla 12
	sta orune+30,3
	ldx z2+1,3		;Get 8K back into xr3 [when did it leave?]
	set pbk		;Break around type setup routine
	lda omtex,3		;Get pointer to message for exec
	sta otad,3		;and put it in address for res routine
	ldo
	sta otypf,3		;Set up type entrance call for exec
	set pst		;and get back in API
	set prq		;set prq
	bru 2,1		;and return - message is typed.
omtex:dec orune
	dec -30

	stl			;Dump
	ejt
!!Page 260
,	********************************************

,	   ODUMP is entered when the D-30 gives a
,	dump-batchmode message.  It results in the
,	complete dump of a system on tape or the
,	disk, depending on parameters previously
,	specified.  All conditions are save for later
,	restoration.  The 235-exec is then called
,	back in to memory, with the batch flag set.
,	No attempt is made to restore trap mode
,	conditions - thus no system should run in
,	trap mode under background.  [JSM: then what's
, 	the purpose of Batch part 3 - Trap Restore?]
,	Disk dump format -
,	    Four 4K-recods written on high-speed
,	    tracks.
,	Tape dump format -
,	    Lower memory in 2 records on tape
,	    Upper memory on two 4K disk records.

odump:bss 0

	lac
	sub otim2t,3	;Accumulate running time
	add otim2,3
	sta otim2,3
	fst oarr,3		;Save AX
	xaq ,A
	fst oarr+2,3	;and QX
	lda otmp		;[Save location in user's program]
	sta oarr+4,3
	lda onfl,3		;[Now save AAU modes--assume]
	bar bup,7		;[normalized floating point to]
	lda ounf,3		;[start, then test for un-normalized]
	bzr bfx,7		;[and fixed-point modes respectively]
	lda ofix,3
	sta orunm,3		;set mode-set in restore sequence
	lda osxg,3		;[Preserve index register group]
	oga
	sta orung,3		;Set index-group-restore into restore sequence

	lda othree,3	;Tell D-30 to stop counting
	spb ospmb,2
odump1:lda otip,3		;Wait for any tape operations to be
	sta z2		;completed and corrected before exit
	lda otlst,2
	bpl
	bru odump2
	spb otop,2		;Wait for tapes to come ready
	dec 0
	spb otape,1		;Go to routine until null condition
!!Page 262
	bru odump1		;and see if done
odump2:lda odip,3		;Make sure disk operation is done
	sta z2
	lda odlst,2
	bze			;If list is zero, no task
	bru odump3
	ado			;If minus-one then task in progress
	bnz
	bru odump3
	spb odwrp,1		;so finish task
	bru odump2		;and see if done
odump3:ldx z2+1,0		;Wil serve for 0, since is 8K
	bcr			;Check card reader
	bru odump4		;OK - dump
	inx 1,0
	bxl 3000,0		;Will give slightly more than u/lth second
	bru *-4		;Go check again  [1/12th??]
odump4:spb odask,2	;Ask D-30
	lda opar,3
	bze			;If zero, dump on disk, else tapes
	bru oddmp
	spb otop,2		;Else dump on tapes
	z03 0			;Write out around index and mailboxes
odtc:	z00 128		;Number of words - handler inserted
	spb otop,2
	oct 0300230		;Dump beginning word
odtc2:oct 0017550		;Number of words, handler inserted
,	Enter odmp2 to dump upper memory on disk
odmp2:bru *+1		;Filled in with SPB OTRAP,1 if necessary
	spb odop,2
	z37 64		;Third 4K block
	dec 8192
	oct 25100		;Disk address
	spb odop,2
	z37 64		;Last block
	dec 12288		;[8192+4096]
	oct 25500
	spb odop,2		;Get bootstrap for exec
	z12 1
	dec load1
oo2476:oct 2476
	ldz
	sta z1		;Set zero into xr1
	spb odskwt,2	;Wait for bootstrap to get in
	lmo			;Set flag in bootstrap to get ores entrance
	sta sbak		;Set flag in exec to indicate batch mode
	lda io1
	sta sbak+1		;Front card status
	set pst
	set pbk		;Immediately get out
	sxg 0
!!Page 262
	bru load1

oddmp:bss 0			;Dump from disk
	spb odop,2
	z37 64		;Dump first 4k of memory
	dec 0
	oct 24100		;Address on disk 0
	spb odop,2		;Dump second 4K
	z37 64
	dec 4096
	oct 24500		;Disk position
	bru odmp2

	stl			;Disk routine
	ejt
!!Page 263

,	********************************************
,	    ODSK is the disk read-write subroutine.
,	It scans a 4-words-per-entry list, executing
,	a given entry if the disk is ready, setting a
,	task done flag if the operation is done, else
,	just returning.


odisk:bss 0			;Process previously built disk task list
	lda odip,3		;Get internal pointer to task list
	sta z2
odisk2:dld odlst,2
	bze
	bru 1,1		;No disk task waiting
	ado
	bze
	bru odwrp		;Was minus 1, so task in progress
	sbo
	dst odpb,3		;Put commands away
	lda odlst+2,2
	sta odpb+2,3	;and set last instruction
	lmo			;Preset entry to in-progress
	sta odlst,2
	lda othree,3	;Tell Mike [Busch] to stop couting time
	spb ospmb,2
	spb odask,2		;Ask for disk before using
	lac
	add otwen,3
	sta odclk,3		;Set countdown for disk.
	nop
	ddc 0
	org *-3
	spb odop,2
odpb:	dec -
	dec -
	dec -
	bze			;Check return status
	bru odpb1		;OK, just get D-30 going again
	ldo
	sla 19-4		;Set illegal address on
	ory odst,3
odpb1:lda ofour,3		;and start counting time
	spb pspmb,2
odwrp:bcs brr,0		;[Check for disk ready]
	bru odpb2		;Skip clock check and disk wait
	lac			;Check for countdown
	cab odclk,3
	bru 1,1		;Not counted down yet
	nop
!!Page 264
	spb odskwt,2	;Dump must have intervened - so get disk
odpb2:bcs ber,0		;Now see if read successful
	bru oderc		;If not, correct it
odwrp2:lda odip,3		;Get list pointer again
	sta z2
	ldz
	sta odlst,2		;Preset task to completed
	lda odlst+3,2	;Get address of status-return word
	sta z2
	lda odst,3		;Get disk status word
	bze
	ldo			;If AOK, set 1 status
	sta 3,2
	ldz
	sta odst,3		;and then set disk status to 0 for next
	sta odec,3		;and set error count down
	spb orelin,2	;Relinquisk so D-30 can get int
	lda odip,3		;Bump up pointer to disk list
	sta z2
	inx 4,2
	lda z2
	bxh 16,2		;Check for wrap-around
	lda o8K,3
	sta odip,3		;and put back for next time
	bru 1,1

oderc:lda odec,3		;Error on read
	ado
	sta odec,3		;Bump up error count
	cab oseven,3
	bru *+2		;Not limit yet
	bru odte		;Too late, give parity message
	ldo
	sla 19-1		;Set parity, but recovered message
	ory odst,3
	lda odpb,3		;and restore task list
	sta odlst,2
	bru odisk2		;and try again
odte:	ldz
	chs			;- indicates non-recovered parity
	ory odst,3
	bru odwrp2		;and wrapup as if read was OK

	stl			;Tape routine
	ejt
!!Page 265

,	********************************************

,	    OTAP is the tape operation subroutine.
,	It scans a list of tape operations, executing
,	them as the tape controller comes ready,
,	setting flags as each operation is completed.
,	All error checking, and error messages, are
,	taken care of internally.
,	    The calling sequence to execute a tape
,	operation is as follows -
,	   LDA ONE
,	   SPB TAPEOP (=37001)
,	   DEC pointer to the parameter list
,	Four-word parameter list has the following
,	form
,	   SEL x  - tape controller desired
,	   Word 1 of tape command -
,	   Word 2 of tape command -
,	   DEC 0

,	Alternately
,	   LDO
,	   SPB EXEC   1
,	   SEL 1
,	   word 1
,	   word 2
,	   DEC 0    flag
,	   return


,	When OTAPE is entered, it puts the supplied
,	parameters into a task list, and immediately
,	exits to the user's program, after setting
,	the -DEC 0- word of the calling sequence
,	to 0.  The tape operation is initiated as soon
,	as the tape controller is ready.
,	When the operation has been completed, the
,	TAPEOP routine will set the -DEC 0- word as
,	follows -
,	   =  1 if the operation was normally successful
,	   =  2 if there was an EOT indication
,	   =  4 if there was an EOF indication
,	   = 10 if there was a recovered read error
,	     which was recovered by changing read modes
,	   = 20 if the error was not recoverable
,	     after 5 tries at a read or write.
,	   = 40 if the instruction caused the tape
,	     controller to go permanently not ready.


!!Page 266
,	No other status returns are possible.

otape:bss 0
	lda otip,3		;Pick up pointer to tape task list.
	sta z2		;and put in xr2
	dld otlst,2		;pick up next list entry
	bnz			;If so there is an entry
	bcs rtn,1		;See if tapes ready
	bru 1,1		;Either no tasks or tapes not ready
	ado			;See if operation just completed
	bze			;If so - was minus 1
	bru otwrp		;so go set flags and wrap up
	sbo			;Restore - is real command
	dst otpb,3		;Put in otop calling sequence
	lmo			;and set entry to task initiated
	sta otlst,2
	nop			;***
	ddc 0			;***
	org *-3		;***
	spb otop,2		;Execute tape commands
otpb:	dec -
	dec -
	bru 1,1		;and exit

otwrp:bss 0			;Enter here after tape operation completed
	sta otlst,2		;and set entry to completed - for now -
	bcs bne,1
	bru otwrp2		;No errors
	lda otec,3		;Check error count
	sbo			;and decrement
	sta otec,3
	bnz
	bru otwrp1		;Countdown not done - so try again
	lda otwen,3		;Get octal 20 - error flag
	sta otst,3		;and put in status word
	bru otera		;Erase if write or change mode if read
otwrp1:lda otpb,3		;Pick up tape command giving error
	sta otlst,2
	spb oter,2		;and go correct bad operation
	bru 1,1
otwrp2:bcs bnf,1		;EOF test
	bru *+3		;No end of file
	lda ofour,3
	ory otst,3		;Put EOF bit on in status word
	bcs bnt,1		;Test EOT
	bru *+3		;No end of tape
	lda otwo,3		;Pick up EOT indicator
	ory otst,3		;and put into status word
	lda otlst+2,2	;Get flag location
	xaq			;and save
!!Page 267
	inx 4,2		;Point to next list entry
	lda z2
	bxh 16,2		;Four entries in list
	lda o8K,3		;Initialize pointer at 8K
	sta otip,3		;and save pointer to next entry
	xaq			;Get back place to put status
	sta z2
	lda otst,3		;Get status
	bze			;and if it is zero
	ldo			;job completed
	sta 3,2		;and store in user's parameter list
	ldz			;Job completed
	sta otst,3		;Set status word zero,
	sta oswc,3		;set switch mode flag off
	lda oseven,3	;Preset error count to 7
	sta otec,3		;and error count 0
	bru otape		;Now take a look at that next entry

,	Output running time on the typewriter
ottim:bss 0
	stx odret,0
	lda otim2,3		;Real running time
	spb ogtim,2
	dec otimr
	spb otyp,2		;Set up to be typed
	dec otimt
	ldo
	sta otypf,3
	ldx odre,2
	set prq
	bru 1,2
,	[Needs ejt after stl once baseline established]
	stl			;Batch part 2
,	********************************************

odlst:bss 0			;Disk task list
,	Entry 1
	dec 0
	dec 0
	dec 0
	dec 0			;Parameter pointer
,	Entry 2
	dec 0
	dec 0
	dec 0
	dec 0	
,	Entry 3
	dec 0
	dec 0
	dec 0
	dec 0	
!!Page 268
,	Entry 4
	dec 0
	dec 0
	dec 0
	dec 0	
otlst:bss 0			;Tape task list
,	Entry 1
	dec 0
	dec 0
	dec 0
	dec 0
,	Entry 2
	dec 0
	dec 0
	dec 0
	dec 0	
,	Entry 3
	dec 0
	dec 0
	dec 0
	dec 0	
,	Entry 4
	dec 0
	dec 0
	dec 0
	dec 0


,	    OSTOP is entered if an S is typed on the
,	console typewriter while a batch program is
,	running.  The result is the complete abortion
,	of this program, and restoration of normal
,	batch mode.

ostop0:ldo			;Set flag to look for BACK card
	sta io1
ostop:bss 0
	lac			;Accumulate running time
	sub otim2t,3
	add otim2,3		;Accumulate actual running time
	sta otim2,3

	ldo			;Set flag in overlay to tell -ORES- same
	sta obflg,3		;Tell ORES batch job done.
	lda othree,3	;and now tell D-30 to stop counting
	spb ospmb,2
	spb odask,3		;Get disk
	bru odmp2		;and enter in middle of dump routine.

odmp:	oct -11		;Dump-batch message from D-30
otst:	dec 0			;Used to hold tape status word return
!!Page 269
otec:	dec 7			;Tape error count - initialize at seven
oarr:	bss 6			;Storage for dump {=swap]
oeom:	oct 55		;End-of-message character for type routine
osxg:	sxg 0
ounf:	set uflpoint
ofix:	set fixpoint
ofnl:	set nflpoint
odip:	dec 8192		;Internal pointer to API disk taks list
odst:	dec 0			;Holds disk status for system subroutine
otip:	dec 8192		;Points to tape list command (iternal)
odo:	dec 8192		;Pointer to disk task list
oto:	dec 8192		;Pointer to tape task list
odsl:	bss 0			;List of scratch area addresses on disk
	oct 30000
	oct 30400
	oct 31000
	oct 31400
	dec 0			;Only 4 areas available -
	bss 4			;(More can be put here - last must be a 0)
odsa:	dec 8192		;Pointer to scratch area being supplied
odclk:dec 0			;Count down on disk with real clock - svd here

	loc 6000
area:	eqo 36000
oba2m:ldx 8K,3
	lda oba3+2
	sta oloba3+2,3
	bru *+3
	dec execov
	dec -512
	dld *-2
	mov area		;Move
,	Read exec back in
	bcs brn,0
	bru *-1
oba2n:sel 0
	prf ,0
	oct 2600		;Get exec
	bcs brn,0
	bru *-1
	sel 0
	rrf 8,0
	    %area
	bcs brn,0
	bru *-1
	bcs ber,0
	bru oba2n
	bru lovwrt		;Now write on disk
	
	tcd oba2m

!!Page 270
	stl			;Batch part 3 - Trap restore
	ejt
!!Page 271
	org pernum
	dec 36
	dec oba3


	loc 34600
,	Restore for trap
,	Must put hold indicators back and get into
,	trap program if necessary

ortrap:stx otmp2,1	;Save entrance
	lda z2+1		;Get 8K bit
	sta tx2+1		;Set in trap register
	lda .orst.,3	;Set for trap
	sta itrap-1
	sta itrap
	sta itrap+1
	lda otrfl,3		;Get indicator flag
	sta z1
	set fixpoint	;Make it easy to get a trap
	bru *+1,1		;Now see what has to be restored
	bru ortrp		;In trap[mode] program
	bru ortri		;Not in trap program
	set ntpmode		;Trap not set

ocrest:spb ohold,2	;Restore hold indicators
	dld omovt2,3	;Restore trap registers
	mov ostrp
	ldx otmp2,1		;Get back to rest of restore
	bru 1,1
,	In trap program
ortrp:set trpmode		;Fudge way into trap
	fdv ozero,3		;Generate trap
	set pst		;Get out of API
	set pbk
	bru *+1,3
orstb:rin			;Enter from self-caused trap
	lda .orex.,3	;have to get back in API
	sta z2+2		;Fudge entrance
	set pst
	set prq		;set prq

orex:	lda oapib,3		;Get API branch back
	sta z2+2
	bru ocrest		;and continue with restore

ortri:spb ohold,2		;Not in trap program when interrupted
	set trpmode		;Restore hold indicators and set trap
	bru ocrest+1	;and leave

ohold:lda otimfl,3	;Mode flag
!!Page 272
	sta z1
	bru *+1,1
	bru 1,2		;None on
	bru oocov		;Overflow hold on
	bru ocun		;Underflow hold on
	fdv zero,3		;Divide check on
	bru 1,2		;Get out

oocov:fld oocov1,3	;overflow hold on
	fad oocov1,3	;1777777.1777777
	bru 1,2		;Leave
oocov1:oct 1777777
	oct 1777777
ocun:	fld ocun1,3		;Underlow on
	fad ocun1,3		;2000000.2000000
	bru 1,2		;and exit
ocun1:oct 2000000
	oct 2000000
ozer:	ddc 0
omovt1:dec ostrp
	dec -7
omovt2:dec itrap-1
	dec -7
otrfl:bss 1			;Trap flag
otimfl:bss 1		;Mode flag
.otrs]:spb tx2,0
.otrs.:bru otrs,3
.otri.:bru otri,3
.otra.:spb otrap,1
.ortr.:spb ortrap,1
.orst.:spb bru orstb,3
.orex.:bru orex,3
ostrp:bss 7			;Trap save

	stl			;Batch 3 - part of initial start
	ejt
,	Continuation of ORUNF in OBA1
,	Sets up for proper loader and dump
orun.3:ldo
	sta cmessb		;Reset
	ldx t+4,1		;Get parameters from catalog
	lda odad,1		;Type of loader
	sta orun30+1,3
	lda odad+1,1	;Loader address
	sta orun30+2,3
	lda odad+2,1
	sta orun30+3,3
orun30:spb odop,2		;Disk operation to get loader
	dec -
	dec -
	dec -
	lda bdc		;Get dump load info
	sta opar,3		;0 if on disk, handler bits if
	ory oltc,3		;on tape
	ory oltc2,3
	ory odtc,3
	ory odtc2,3
	lac
	sta otim2t,3
	spb orelin,2	;Give back disk
	sxg 0			;Set group zero for loader entrance
	lda odect,3		;Pointer to parameter list
	sta 2			;for loader
	ldx t+4,1		;Loader address
	lda odad+1,1	;Address from disk read
	sta z1
	set pst		;out of API and
	bru 0,1		;to loader

odect:dec t			;Address of t-array

,	Initialize branches to trap routines
oitrap:lda .otra.,3	;Get start
	sta odmp2,3		;Put in correct SPB
	lda .ortr.,3	;Restore
	sta oruna,3
	bru 1,1		;Back to guy's program

	stl			;Sysout
	ejt
!!Page 274  10/14/02
	loc 35000

,	Sysout buffers

osbuf1:bss 110
osbuf2:bss 110


,	Sysout routine
,	Entrance on xr-1, A-reg minus if indirect -
,	plus if direct.  First two words are sysout
,	control words, third word is address of data


,	Regular entrance is to here

oso:	ldx z2+1,3		;Get 8K bit
	bpl			;See if direct or indirect
	bru oso1		;direct
	lda 1,1		;Get pointer in A
	inx 2,1		;Return in 1
	bru oso2		;Skip indirect
oso1:	inx 1,1		;Step to parameter
	stx odret2,1
	lda odret2		;Get pointer in A
	inx 3,1		;step pointer for return
oso2:	sta osop,3		;Save pointer permanently
	sta odret2
	ldx odret2,2	;Get in 2
	stx odret2,1	;Get return
	lda odret2
	sta osor,3		;and put where it belongs
	lda 0,2		;xr-2 has pointer to list
	sta osobl,3		;Save parameter in my list
	lda 1,2
	sta osobl+1,3
	lda 2,2
	sta osobl+2,3
	lda osobp,3		;Get location to put in
	add osobw,3
	sta odret2
	ldx odret2,1	;Address to move to
	dld osobl,3
	sta 0,1
	xaq
	sta 1,1		;Control words stored
	ext omw,3		;3777600
	sta osobw1,3	;Number of words to write
	cab od110,3		;See if legal length
	bru oso3
	bru oso3
!!Page 275
	bru osore		;Exit
oso3:	lda osobw,3
	add otwo,3
	sta osobw,3		;Increment word count
	add osobw1,3
	cab od110		;dec 110
	bru osok		;Just move in
	bru osok

,	Length too great for one buffer, so split.
,	Change number of words and address and then
,	write.

	sub od110,3		;Get number of excess words
	sta osobw2,3	;Save for next operation
	sub osobw1,3	;Get number to move
	lqa			;Set up to move
	neg
	add osobl+2,3	;Save new address to write from next time
	sta otmp1		;Save for awhile
	lda osobl+2,3	;From address
	ada omop,3
	sta *+3,3
	lda osobp,3
	add osobw,3
	mov *			;Constructed
	lda od110,3
	sta osobw,3		;For tape write
	lda osobw2,3
	sta osobw1,3	;Set to finish operation
	lda otmp1
	sta osobl+2,3	;New address
	bru osowr		;Write it

,	Room to plunk in present buffer

osok:	lda osobw,1
	neg
	xaq			;Set for move
	lda osobl+2,3	;From address
	add omop,3		;Z24
	sta *+3,3		;Put in move command
	lda osobp,3
	add osobw,3
	mov *			;Constructed
	lda osobw,3
	add osobw1,3
	sta osobw,3		;Reset word count
	cab od108,3
	bru osore		;Do not need to write out yet
	bru osore
!!Page 276
	ldz
	sta osobw1,3	;Reset words to write
	bru osowr		;Must write out, can not split control words

,	Time to write tape.  After finished switch
,	buffers if other one ready.

osowr:dld osotp,3		;Pointer to next tape list
	sta odret2
	sta osowr1+1,3
	xaq
	dst osotp,3		;Switch for next time
	ldx odret2,2
	dld osobp,3
	sto 1,2		;Put address in
	xaq
	dst osobp,3		;Flip buffer
	lda osobw,3		;Word count
	bze
	bru osok		;Punt if zero
	sto 2,2		;put away
	ldo
osowr1:spb exec,1		;Write tape
	dec 0			;Constructed
	ldz
	sta osobw,3		;Set buffer count to zero
,	Now check to see if the other buffer is ready
	lda osotp,3
	sta odret2
	ldx odret2,2
	lda 3,2		;Get flag word
	bze			;Wait till tape operation done
	bru *-2
	bod
	bru osok		;Buffer OK to fill
	sra 1
	bod
	bru osoeot		;End of tape, change them
	bru osok


,	End of tape occurred, write record and rewind,
,	then switch tape.

!!JSM: check calls to exec with same number
!!in A but different-length calling sequences:
!!OSOWR1 and OSOEOT
osoeot:ldo
	spb exec,1
	sel 1
	wtb osyet,7		;End tape record
	    %13
	dec 0
	ldo
!!Page 277
	spb exec,1
	sel 1
	rwd ,7
	dec 0
	ldz			;If we get this far make sure dump is on
	sta opar,3		;the disk

,	Wait until next tape is mounted
	lda othree,3
	spb exec,1 
	dec osoty		;Toggle 19 when sysout tape is ready
	ldz
	rcs
	bev
!!JSM: ERROR: the branch below as originally specified
!!was a
!!    bru *-4
!!which branches back to the instruction containing
!!    dec osoty
!!instead of to the instruction containing
!!	ldz
!!which is what was intended.
!!I have change the instruction to the one below
	bru *-3
	ldz
	rcs
	bod
	bru *-3
	bru osok

,	Enter here to write out sysout buffer
osoter:stx otmp2,1	;Save entrance
	lda odter1,3
	sta osor,3		;Set up to return correctly
	bru osowr		;Write out
oster1:lda osot1+3,3	;Make sure done
	bze
	bru *-2
	lda osot2+3,3
	bze
	bru *-2
	ldx otmp2,1		;All done so get out
	bru 1,1

odter1:dec oster1

,	Enter here to return to user's program

osore:lda osor,3		;Return address
	sta odret2
	ldx odret2,1
	bru 0,1		;Get back

,	Flip-flop constants

osobp:dec osbu1
	dec osbu2
osobw:dec 0			;Number of words in use in buffer
osobl:dec 0			;User's parameter list
!!Page 278
	dec 0
	dec 0
osobw1:dec 0		;Words to write
osobw2:dec 0		;used if overflow
osotp:dec osot1		;Next tape list to use
	dec osot2
osdp:	bss 1			;Pointer to user's info
osor:	bss 1			;Return address
osyet:oct 21
od100:dec 100
od108:dec 018
omw:	oct 3777600
osot1:sel 1			;Dummy parameter list actual parameters are
	z03 0,1
	z30 0
	dec 1			;Initialize flag to 1
osot2:sel 1			;Dummy parameters
	z03 0,1
	z30 0
	dec 1

,	New s/o tg 19
osoty:alf NEW
	alf & S/
	alf O T
	alf G 1
	oct 113755

	stl			;Trap save
	ejt
!!Page 279
,	Save trap conditions

otrap:stx otmp2,1		;Save entrance
	dld omovt1,3	;Save trap locations
	mov itrap-1
	sta xr312		;Initialize register to 0
	lda z2+1		;Get 8K bit
	sta tx2+1		;put in for trap
	sta xr312+1
	lda .otrs.,3
	sta tx2		;Branch for simultaneous interrupts
	lda .otrs],3	;but you have to get there first
	sta itrap-1
	sta itrap
	sta itrap+1
,	Now see how fouled up trap is

,	Save hold indicators
	ldz			;Zero if none
	bar boo,7
	ldo			;Overflow hold on
	bar buo,7
	lda otwo,3		;Underflow hold on
	bar bdc,7
	lda othree,3	;Divide check on
	add z2+1		;Set upper 8K bit
	sta otmifl,3	;Trap indicator flag

	sxg 31		;Get into group away from punch
	set pst		;Get out of API
	set pbk
	bru *+1,3		;If simultaneous trap, then program
	spb *+1,2		;will go to OTRS, else here
	lda xr312		;See if in trap program
	bnz
	bru otrchk		;Not in trap program, but see if it is set
!!If fall through, then in a trap-interrupt program

,	OBTEX sets a flag as follows
,	   0 - in trap program
,	   1 - trap mode set
,	   2 - trap mode not set

obtex:add z2+1
	sta otrfl,3		;Trap flag for restore
	rin			;Do not foul anyone else
	set trpmode
	set ntpmode
	bru *+1,3		;Get out of trap program if in one
,	Have to get back into API
	lda otmp2		;So set up return
	sta z2
!!Page 280
	lda *+4,3		;Bru 1,2
	sta z2+2
	set pst
	set prq		;and interrupt to go there

	bru 1,2		;constant for OBTEX


otrs:	lda oarr+4,3	;Simultaneous trap and interrupt
	sta ostrp+4,3	;Set trap register 1
,	Following works because in lower memory
	lda tx2-2		;Get register 0
	sto oarr+4,3
	ldz
	bru obtex

otrchk:lda .otri.,3	;See if trap[mode] set
	sta itrap+1		;If set, a branch to OTRI will occur
	set fixpoint	;Make sure FDV will trap
	fdv ozero,3
	lda otwo,3		;[Trap did not occur, land here]
	bru obtex

otri:	ldo			;[Trap did occur, land here]
	bru obtex

	stl			;Batch part 3 - overlay call and terminal exit
	ejt
!!Page 281
,	     Overlay calling entrance - code is
,	4 in A register, and SPB must be followed
,	by a 4-word alphabetic name for the overlay
,	desired.  The routine destroys index groups
,	1 and 2 and the T-array in the user's program
oovr:	inx 1,1		;Get pointer to list
	stx odret2,2
	lda odret2
	sxg 0
	ldx z2+1,3
	sta oovrp,3		;Store in pointer
	spb osoter,1	;Terminate sysout buffer
oovr1:lda otwo,3		;Disk operation
	spb exec,1
	dec ovlst2
	lda ovlst2+3,3
	bze
	bru *-2
	bev			;Wait till get a one
	bru oovr1
	bru ovsc		;Go to overlay scan
ovlst2:z12 7		;7 records
	oct 35000
	oct 0			;From
	dec 0

oovrp:bss 1

,	Terminal exit
oterm:spb osoter,1	;Terminate sysout buffer
	lda otwo,3		;Set job-done code into API entrance flag
	sta otypf,3
	lmo
	sta io1		;Have front
	set prq
	bru *-1		;Just in case get a return

,	Restore for OBA3
	loc 6000
oba3m:ldx 8K,3
	lda oba4+2
	sta ovlst2+2,3	;Initialize disk address
	dld oba3m1
	mov ortrap		;Get trap routine with overlay
	bru *+3
	dec execov
	dec -512
	dld *-2
	mov ovcat		;Move to 37000
,	Read exec back in
	bcs brn,0
!!Page 282
	bru *-1
oba3m0:sel 0
	prf ,0
	oct 2554		;0 5 54
	bcs brn,0
	bru *-1
	sel 0
	rrf 10,0
	    %ortrap
	bcs brn,0
	bru *-1
	bcs ber,0
	bru oba3m0
	bru lovwrt		;Now write on the disk

oba3m1:dec osbu1
	dec -128

	tcd oba3m

	stl			;Batch part 4 - overlay scan
	ejt
!!Page 283

	org pernum
	dec 38
	dec oba4
	loc 35000

ovcat:bss 256		;Space to read in catalog

,	Overlay lengths are critical.
,	OBA4 can only be 7 records long because it is
,	called from the last record of OBA3.  Also the
,	Disk Image Loader can only be 6 records long
,	because it is called from the 35600 part of
,	this overlay.

,	Start of scan for overlay
,	Executed in group zero

ovsc:	lda oovrp,3
	add omop,3		;Move
	sta *+2,3
	dld ocov,3		;Move to OVCT array
	mov *
	lda ocata,3
	add otwo,3
	sta ovlst1+2,3	;Disk address
ovs1.1:lda otwo,3
	spb exec,1
	dec ovlst1		;Pointer to parameters
	lda ovst1+3,3
	bze
	bru *-2
	bev
	bru ovs1.1
	ldx z2+1,2
ovs1.2:dld ovcat,2	;Scan catalog
	bze
	bru opunt		;Not in catalog, so terminal exit
	dcb ovct,3		;Check first two words
	bru ovs1.3
	bru ovsc2		;Check next two
ovs1.3:inx 8,2
	bxh 256,2		;See if done with record
	bru ovsc3		;get next one
	bru ovs1.2		;Look at next record [entry?]
ovsc2:ldl ovcat+2,2
	bmi
	bru ovs1.4		;Minus so just check first two
	dcb ovct+2,3	;Check second two
	bru ovs1.3		;no match
	bru ovs1.4
!!Page 284
	bru ovs1.3
ovs1.4:inx ovcat+4,2
	lda 0,2
	sta 1
	bru *+1,1
	bru opunt		;[0] Not allowed from overlay call
	bru opunt		;[1] Not allowed from overlay call
	bru opunt		;[2] Not allowed from overlay call
	bru opunt		;[3] Not allowed from overlay call
	bru opunt		;[4] Not allowed from overlay call
	bru opunt		;[5] Not allowed from overlay call
	bru opunt		;[6] Not allowed from overlay call
	bru ovsc4
ovsc3:lda ovlst1+2,3	;Get next 4 catalog records
	add ov8,3
	sta ovlst1+2,3
	bru ovs1.1		;and read it in

,	Gets correct loader for system
ovsc4:lda 2
	ado
	add omop,3		;Move to T-array
	sta *+2,3
	dld ocov1,3
	mov *
,	Go to OBA to get loader and system
,	Fudge API entrance
	set pbk
	lda z2+2
	sta z0
	lda ovapi,3		;Fudge API branch
	sta z2+2
	set prq		;set prq
	set pst
	nop
ovsc5:lda z0
	sta z2+2		;Restore old API branch
	bru orunf2		;Get loader

,	Someone goofed, terminal exit
opunt:ldo
	sta io1		;Look for BACK card
	lda otwo,3		;Set up terminal exit
	sta otypf,3
	set prq		;[Request] interrupt
	bru *-1

ov8:	dec 8
ocov1:dec ovct+4
	dec -3
ovlst1:bss 0
!!Page 285
	z12 4			;Read 4 records
	oct 35000		;into 35000
	oct 0			;disk address
	dec 0			;flag
ocata:oct 0			;Address of catalog - filled in in load
ovapi:bru ovsc5,3

,	This reads in the overlay after it has been
,	found in the catalog.  It is almost the same
,	as ORUNF.

	loc 35600
orunf2:lda ovct+4,3	;Get out of the way of the loader
	sta z1
	spb odask,2		;Get the disk
	lda odad,1		;Pick up
	sta orunf3+1,3	;loader disk address
	lda odad+1,1	;and set in parameter list
	sta orunf3+2,3
	lda odad+2,1
	sta orunf3+3,3
orunf3:spb odop,2
	dec -
	dec -
	dec -
	spb orelin,2	;Relinquish - read next may be from tape
	sxg 0			;Set group zero for loader entrance
	lda ocov,3		;Pick up pointer to parameter list
	sta 2			;and put where loader can get at it.
	lda orunf3+2,3	;Gives address from disk read
	sta z1
	set pst		;Exit API mode
	bru 0,1		;and exit to loader

ovct:	bss 7			;T-array for overlay calls

ocov:	dec ovct
	dec -4

exec:	eqo 37001

,	Restore routine for OBA4

	loc 6000
oba4m:ldx 8K,3
	lda ocat+2
	sta ocata,3		;Initialize disk address
	ldz			;Zero buffer area
	sta ovcat,3
	bru *+3
	dec ovcat+1
!!Page 286
	dec -255
	dld *-2
	mov ovcat
	nop
	bru *+3
	dec execov
	dec -512
	dld *-2
	mov ovcat		;Move to 37000
,	Read exec back in
	bcs brn,0
	bru *-1
oba4mo:sel 0
	prf ,0
	oct 2560		;Address 0 5 56
	bcs brn,0
	bru *-1
	sel 0
	rrf 10,0
	    %ovcat
	bcs brn,0
	bru *-1
	bcs ber,0
	bru oba4m0
	bru lovwrt		;Now write overlay on the disk

	tcd oba4m

	stl			;Background card catalog
	ejt
!!Page 287
	org pernum
	dec 40
	dec ocat


	org execov

,	Disk addresses available for systems
	oct 40000
	oct 0
	oct 40400
	oct 0
	oct 41000
	oct 0
	oct 41400
	oct 0
	oct 42000
	oct 0
	oct 42400
	oct 0
	oct 43000
	oct 0
	oct 43400
	oct 0
	oct 44000
	oct 0
	oct 44400
	oct 0
	oct 45000
	oct 0
	oct 45400
	oct 0
	oct 46000
	oct 0
	oct 46400
	oct 0
	oct 47000
	oct 0
	oct 47400
	oct 0
	oct 50000
	oct 0
	oct 50400
	oct 0
	oct 51000
	oct 0
	oct 51400
	oct 0
	dec -1

,	Catalog of card types ---------------
!!Page 288

,	Each entry to the catalog is 8 words long.
,	The first 4 words consist of the alphanumeric
,	system name, with blanks replaced by zeroes.
,	   The fifth word is a transfer to the
,	excecutive subroutine which processes this
,	type of card.  [Revised--see below]
,	   The rest of the information is peculiar
,	to the type of card the entry corresponds to
,	and may consist of disk address, loader names
,	etc., etc.
,	The catalog search is terminated upon finding
,	a 0-entry, or wrapping around memory.

,	The fifth word of ech catalog entry is used
,	for an indexed branch as follows.

,	BBACK  20001
,	BINT2  20002
,     BINT   20003
,     BTYPE  20004
,     BRWND  20005
,     BLSEW  20006
,     BEXT   20007

	org excv+64

	alf BAC		;BACK card
	alf K00
	alf 000
	alf 000
	oct 20001
	dec 0
	dec 0
	dec 0

	alf LIS		;List deck
	alf TDE
	alf CK0
	alf 000
	oct 20002
	oct 456237		;N,S,CR - indiates to C/P overlay, no trans.
	alf C/P
	dec 0

	alf LIS		;List deck T (translated)
	alf TDE
	alf CKT
	alf 000
	oct 20002
	oct 636237		;T,S,CR
!!Page 289
	alf C/P
	dec 0

	alf LIS		;List GAP assembly
	alf TGA
	alf PAS
	alf SEM
	oct 20003
	alf G/P
	dec 0
	dec 0

	alf REP		;Reproduce
	alf ROD
	alf UCE
	alf 000
	oct 20003
	alf C/C
	dec 0
	dec 0

	alf CAR		;Card to tape
	alf DTO
	alf TAP
	alf E00
	oct 20002
	oct 370000		;CR
	alf C/T
	dec 0

	alf TYP		;Type and halt
	alf EAN
	alf DHA
	alf LT0
	oct 20004
	dec 0
	dec 0
	dec 0

	alf TYP		;Type no halt
	alf ENO
	alf HAL
	alf T00
	oct 20004
	dec -1
	dec 0
	dec 0

	alf TYP		;Type
	alf E00
	alf 000
!!Page 290
	alf 000
	oct 20004
	dec 0
	dec 0
	dec 0

	alf REW		;Rewind I (tape number)
	alf IND
	dec -1
	alf 000
	oct 20005
	dec 0
	dec 0
	dec 0

	alf SLE		;Slew
	alf W00
	alf 000
	alf 000
	oct 20006
	dec 0
	dec 0
	dec 0

	alf BIN		;Binary
	alf ARY
	alf 000
	alf 000
	oct 20007
	oct 20014
	oct 32030
	dec 0

	dec 0			;End-of-catalog marker


	loc 6000
bcatm:spb $ertyp,2	;Tell them catalog has been loaded
	dec *+2
	bru lovwrt		;and then proceed with load
	oct 373777
	alf BAT
	alf CH 
	alf CAT
	alf LOG
	alf & LO
	alf AD 
	alf COM
	alf PLE
	alf TE.
	oct 375577
!!Page 291

	tcd bcatm

	end sres		;End