extended exec, 7 feb 66

/random constants


npr=6		/number of programs
5i=50000		/core 5 translates to exec core

p1=15		/exec pointer to resource tables
p2=16		/exec pointer to pointer table

adm=360000
wat=722477
eem=724074



















































                
                                
/initial entry, set up resource pointers

1/	jmp 6000

6000/

e1,	eem		/stay in extend mode
	lac i (5i p1
	jda pfx
	dac sd1
	sub (1
	dac sd0
	add (27
	dac adr
	law adr
	dap el 1
	law tsb
	dap el 2
el,	law 1
	add adr
	dac tsb
	idx el 1
	idx el 2
	sas (dac xeq
	jmp el
	lac but
	dac xeq
	lac i d9		/setup console-off restorer
	dac p9
	lac i ti
	dac p8
	lac i re
	dac p7
	lac i d7
	dac p6
	lac i rs9
	dac p5
	jmp e2



sd0,	0	/pointer to drum table entry 0
sd1,	0	/pointer to drum table entry 1
adr,	0	/pointer to administrator word
tsb,	0	/pointer to switch + button word
srr,	0	/pointer to reader service switch
onn,	0	/pointer to mask of consoles on
ill,	0	/pointer to a <jmp ill>
ti,	0	/pointer to a <jmp ti>
re,	0	/pointer to a <jmp re1 1>
rs9,	0	/pointer to a <jmp re9>
d7,	0	/pointer to a <jmp d7>
d8,	0	/pointer to a <jmp d8>
d9,	0	/pointer to a <jmp d9>
rr,	0	/pointer to reader switch
pp,	0	/pointer to punch switch
xrg,	0	/pointer to external register switch
kno,	0	/pointer to knob mask
but,	0	/pointer to button mask






                
                                xeq,	0	/pointer to external equipment switches

































































                
                                
/find something to do

e2,	lac i (5i p2	/setup activation pointers
	jda pfx
	dac iad
	lac i iad
	jda pfx
	dac aw1
	add (npr
	dac lim
	law be
	dap . 4
	idx iad
	lac i iad
	jda pfx
	dac .
	idx .-1
	sas (dac rst 1
	jmp .-6

sea,	idx aw1		/test administrator word against
	sad lim		/next console
	jmp fin
	idx be
	idx act
	idx jfm
	idx kfm
	idx rst
	law 177
	and i act
	and i adr
	sza
	jmp onf		/console turned on or off
	lac i adr
	rar 7s
	and (177
	and i act
	sza
	jmp ar		/arq instruction
	jmp sea		/nothing to do for this console


fin,	dzm i adr
	cla
	wat
	jmp e2

pfx,	0		/give a pointer a core-5 prefix
	dap pfz
	law 7777
	and pfx
	ior (5i
pfz,	jmp .

iad,	0
lim,	0









                
                                
/pointers into user's private variables in exec


aw1,	0	/assignment register 1
be,	0	/break enable register
act,	0	/active list, console mask
jfm,	0	/reactivate bits
kfm,	0	/reactivate mask
rst,	0	/pointer to rest of variables

aw2,	0	/assignment register 2
ac,	0	/ac
io,	0	/io
pc,	0	/pc
pf,	0	/pf
qn,	0	/quanta
dp,	0	/dispatch pointer
cr,	0	/core rename
di,	0	/dia word
sp2,	0	/pointer to inactive variables
rr0,	0	/reader switch
pp0,	0	/punch switch
dtr,	0	/pointer to drum translation table
z81,	0	/private storage
z82,	0	/..for
z83,	0	/..translator
z84,	0	/tyi dispatch address
zzi,	0	/tyi translator entry
zzo,	0	/tyo translator entry
why,	0	/why...
abf,	0	/control word
spc,	0	/special fields
brk,	0	/pointer to breakpoint variables
xe9,	0	/premature trap switch
rs1,	0	/reader ready switch
idc,	0	/ID core rename word

ps0,	0	/direct pointer to drum translation table


rsv,	dap rsu	/set up rest of pointers
	lac i rst
	jda pfx
	dac aw2
	law aw2
	dap rl 1
	law ac
	dap rl 2
rl,	law 1
	add aw2
	dac ac
	idx rl 1
	idx rl 2
	sas (dac idc 1
	jmp rl
	lac i dtr
	jda pfx
	dac ps0
rsu,	jmp .






                
                                /dispatch on arq code

ar,	jsp rsv
	law cod	
	dac iad		/pointer to code table
ar1,	lac i iad
	sad i ac
	jmp ar2		/code found
	sza i
	jmp oop		/0 is last table entry
	law 2
	adm iad
	jmp ar1

ar2,	idx iad
	xct i iad	/exit to proper program
	lac i act
	ior (400000
	dac i act
	jmp sea		/continue task search


oop,	lac i ill	/no such arq
	dac i xe9
	jmp ar2+2

ipc,	dap .+4
	law 1
	add i pc
	dap i pc
	jmp .



































                
                                
/table of arq codes

cod,	 flexo   r	jsp ard	/assign reader
	-flexo   r	jsp drd	/dismiss reader
	 flexo   p	jsp aph	/assign punch
	-flexo   p	jsp dph	/dismiss punch

	 flexo  1f	jsp a1f	/assign one field
	-flexo  1f	jsp d1f	/dismiss one field
	 flexo   f	jsp anf	/assign N fields
	-flexo   f	jsp dnf	/dismiss all fields
	 flexo  af	jsp aaf	/assign field N
	-flexo  af	jsp daf	/dismiss field N
	 flexo  tf	jsp tf	/translate field number

	 flexo  ax	jsp axa	/assign absolute external reg.
	 flexo  sx	jsp axs	/assign shared external reg.
	-flexo   x	jsp dx	/dismiss external register

	 flexo  q1	jsp axq	/assign external eq. 1
	 flexo  q2	jsp axq	/ext. eq. 2
	 flexo  q3	jsp axq	/ext. eq. 3
	 flexo  q4	jsp axq	/ext. eq. 4
	 flexo  q5	jsp axq	/ext. eq. 5
	 flexo  q6	jsp axq	/ext. eq. 6
	 flexo  q7	jsp axq	/ext. eq. 7
	-flexo   q	jsp dxq	/dismiss ext. equipment

	 flexo   k	jsp ak	/assign knobs
	 flexo   b	jsp ab	/assign buttons

	 flexo  c1	jsp amm	/assign second 4K
	-flexo  c1	jsp dmm	/dismiss second 4K

	 flexo  mb	jsp tmb	/translate memory bound

	 +0		jsp mys	/dismiss to MYSTIC




























                
                                
/reader and punch

ard,	dap rpx		/assign reader
	jsp ipc
	lac i rr0
	sas i ill
	jmp rd1		/user has reader
	lac i rr
	sza
	jmp rpx
rd1,	law 177		/reader free or already assigned
	and i act
	dac i rr		/reader now assigned
	lac (skp i
	dac i rr0	/setup to initialize buffer
	lac i rs9
	dac i rs1
	jsp ipc
rpx,	jmp .

drd,	dap rpz		/dismiss reader
	jsp ipc
	lac i rr0
	sad i ill
	jmp rpz		/reader not assigned
	lac i ill
	dac i rr0
	dzm i rr
	lac (skp
	dac i srr
	lac i rs9
	dac i rs1
rpz,	jmp .

aph,	dap pcx		/assign punch
	jsp ipc
	lac i pp0
	sas i ill
	jmp pc2		/user has punch
	lac i pp
	sza
	jmp pcx
	law 177		/punch free
	and i act
	dac i pp
	lac (skp
	dac i pp0	/allow punching
pc2,	jsp ipc
pcx,	jmp .

dph,	dap pcz		/dismiss punch
	jsp ipc
	lac i pp0
	sad i ill
	jmp pcz		/punch not assigned
	lac i ill
	dac i pp0
	dzm i pp
pcz,	jmp .






                
                                
/assign one field, dismiss one field

a1f,	dap a1z		/assign
	jsp ipc
	jsp cff
	sza i
	jmp a1z		/no more fields
	jsp av1
	jsp pv1
	law 177
	and i act
	dac i abs
	lac abs
	sub sd0
	rar 6s
	dac i pse
	lac pse
	sub ps0
	rar 6s
	dac i ac
 	jsp ipc
a1z,	jmp .

d1f,	dap d1z		/dismiss
	jsp ipc
	jsp ps1
	jmp d1z		/none assigned
	lac i psb
	dzm i psb
	ral 6s
	jda abp
	dzm i abp
	jsp ipc
d1z,	jmp .































                
                                
/assign N fields, dismiss all fields

anf,	dap anz		/assign
	jsp ipc
	law i 7777
	and i io
	ral 6s
	cma
	dac t1		/-N
	jsp cuf
	add t1
	sub (1
	dac t2
	sza i
	jmp anz-1	/exact match
	sma
	jmp dns		/dismiss t2 fields
	jsp cff
	add t2
	spa
	jmp anz			/not enough
	jsp av1
	jsp pv1
	jmp . 3

anl,	jsp avn
	jsp pvn
	law 177
	and i act
	dac i abs
	lac abs
	sub sd0
	rar 6s
	dac i pse
	isp t2
	jmp anl
	jsp ipc
anz,	jmp .



























                
                                
/dismiss fields

dnf,	dap anz		/dismiss
	law i 27
	dac t2		/patch 
	jsp ipc
	jsp ipc
	jsp ps1
	jmp dnz		/none assigned
	jmp dnz 1

dnl,	isp t2
	jsp pst
dnz,	jmp anz
	lac i psb
	dzm i psb
	ral 6s
	jda abp
	dzm i abp
	jmp dnl

dns,	lac t2
	cma
	dac t2
	jsp ipc
	jmp dnf 5

/assign field N

aaf,	dap aaz
	jsp ipc
	law 77		/check pseudo field
	and i io
	sza i
	jmp aa1		/no pseudo field specified
	jda ckf
	jmp aaz		/field no. too big
	jda psp
	lac i psp
	sza
	jmp aa5		/pseudo field occupied
	jmp aa2

aa1,	jsp pv1
	lac pse
	dac psp



















                
                                
aa2,	law i 7777	/check absolute field
	and i io
	sza i
	jmp aa3		/no absolute field specified
	ral 6s
	jda ckf
	jmp aaz		/field>26
	xor i spc
	and (77
	sza i
	jmp aaz
	xor i spc
	and (77
	jda abp
	lac i abp
	ior i act
	sas i act
	jmp aaz		/absolute field occupied
	jmp aa4

aa3,	jsp cff
	sza i
	jmp aaz		/no more fields
	jsp av1
	lac abs
	dac abp

aa4,	law 177
	and i act
	dac i abp
	lac abp
	sub sd0
	rar 6s
	dac i psp
aa6,	lac psp
	sub ps0
	rar 6s
	dac i ac
	idx i pc
aaz,	jmp .

aa5,	law i 7777
	and i io
	sza i
	jmp aa6
	xor i psp
	and (370000
	sza
	jmp aaz
	jmp aa6















                
                                
/dismiss field N

daf,	dap daz
	jsp ipc
	lio i io
	sni
	jmp daz-1	/case 4, nothing specified
	cla
	rcl 6s
	rir 6s
	sza
	jmp da1
	swp		/case 1, pseudo field given
	jda ckf
	jmp daz		/>26
	jda psp
	lac i psp
	sza i
	jmp daz		/no field assigned
	dzm i psp
	ral 6s
	jda abp
	dzm i abp
	jmp daz-1

da1,	xor i spc	/case 2,3 - absolute field given
	and (77
	sza i
	jmp daz
	xor i spc
	and (77
	rar 6s
	dac t1
	dio t2
	jsp ps1		/find corresponding pseudo field
	jmp daz		/no fields assigned
	jmp . 3
dal,	jsp pst
	jmp daz		/no such field
	lac i psb
	sas t1
	jmp dal
	sni
	jmp da2
	lac psb		/case 3, both given
	sub ps0
	sas t2
	jmp daz		/but no correspondence

da2,	dzm i psb	/case 2, absolute field given
	lac t1
	ral 6s
	jda abp
	dzm i abp
	jsp ipc
daz,	jmp .









                
                                
/translate field number

tf,	dap tfx
	lac i io
	jda ckf
	jmp tfx 1
	jda psp
	lac i psp
	dac i ac
	jsp ipc
tfx,	jmp .
	law 0
	jmp tfx-2


/subroutines for field assignment

abp,	0		/calculate pointer to absolute field word
	dap aby
	lac sd0
	adm abp
aby,	jmp .

psp,	0		/calculate pointer to pseudo field word
	dap psz
	lac ps0
	adm psp
psz,	jmp .

cff,	dap cfx		/count free fields
	dzm cum
	dzm f1
	law i 26
	dac nt
	lac sd0
	dac ia1
cl,	idx ia1
	lac i ia1
	sad cum
	idx f1
	isp nt
	jmp cl
	lac f1
cfx,	jmp .

cuf,	dap cfx		/count user fields
	law 177
	and i act
	dac cum
	jmp cff 2
cum,	0














                
                                

ps1,	dap psx		/find last assigned pseudo field
	law 27
	add ps0
	dac psb
psl,	law i 1
	add psb
	sad ps0
	jmp psx
	dac psb
	lac i psb
	sza i
	jmp psl
	idx psx
psx,	jmp .

pst,	dap psx		/find next assigned pseudo field
	jmp psl

ckf,	0		/check field no for validity
	dap ckx
	law i 27
	add ckf
	spa
	idx ckx		/<26
	lac ckf
ckx,	jmp .






































                
                                
/more field assignment subroutines

av1,	dap avz		/find first available absolute field
	lac sd0
	dac abs
avl,	idx abs
	lac i abs
	sza
	jmp avl
avz,	jmp .

avn,	dap avz		/find next available absolute field
	jmp avl


pv1,	dap pvz		/find first available pseudo field
	lac ps0
	dac pse
pvl,	idx pse
	lac i pse
	sza
	jmp pvl
pvz,	jmp .

pvn,	dap pvz		/find next available pseudo field
	jmp pvl

abs,	0
pse,	0
psb,	0

f1,	0
ia1,	0
nt,	0































                
                                
/external register

axa,	dap axz		/assign absolute
	jsp ipc
	lac i xrg
	sza i
	jmp ax2
	sas (1
	sad (400000
	jmp ax1
axz,	jmp .

ax1,	lio i aw2	/assigned to one user
	spi i
	jmp axz		/not this user

ax2,	lac (400000	/assign to this user
	dac i xrg
	ior i aw2
	dac i aw2
 	jsp ipc
	jmp axz

axs,	dap asz		/assign shared
	jsp ipc
	lac i xrg
	lio i aw2
	sma
	jmp ax3		/available or now shared
	spi i
	jmp asz		/assigned absolutely, not to this user
	dzm i xrg
	jmp ax4

ax3,	spi
	jmp ax5		/already assigned shared

ax4,	idx i xrg
	lac (400000
	ior i aw2
	dac i aw2
ax5,	jsp ipc
asz,	jmp .

dx,	dap dxz		/dismiss 
	jsp ipc
	lac i aw2
	sma
	jmp dxz		/ext. reg. not assigned
	xor (400000
	dac i aw2	/turn off bit
	lac i xrg
	and (377777	/delete absolute assignment if any
	sza
	sub (1		/reduce share count if shared
	dac i xrg
dxz,	jmp .








                
                                
/external equipment

axq,	dap xqz		/assign
	jsp dxq
	law 7
	and i ac
	rar 6s
	dac t1
	ral 6s
	add xeq
	dac iad
	lac (400000	/permanent assignment bit
	ior i act
	and i iad
	sas i iad
	jmp xqz		/not successful
			/assigned to another user
	lac i act
	dap i iad	/put console mask into switch
	lac i aw1
	and (707777
	ior t1
	dac i aw1
	jsp ipc
xqz,	jmp .

dxq,	dap xqy		/dismiss
	jsp ipc
	lac i aw1
	and (70000
	sza i
	jmp xqy		/none assigned
	ral 6s
	add xeq
	dac iad
	lac i iad	/get switch
	spa
	jmp xqy		/permanently assigned to this console
	dzm i iad
	lac i aw1
	and (707777
	dac i aw1
xqy,	jmp .






















                
                                
/knobs + buttons

ak,	dap akz		/assign knobs
	jsp ipc
	lac i aw2
	ral 5s
	and (17		/knobs assigned to this user
	dac t1
	lac i kno
	cma
	and (17		/knobs available
	ior t1		/..or assigned already
	and i io
	sas i io
	jmp akz
	rar 5s		/ok, assign
	dac t2
	lac i aw2
	and (417777
	ior t2
	dac i aw2
	lac t1		/this user's previous assignment
	cma
	and i kno	/knobs assigned to other users
	ior i io		/or now assigned this user
	dac i kno	/are assigned
	jsp ipc
akz,	jmp .

ab,	dap abz		/assign buttons
	jsp ipc
	lac i aw2
	rar 9s
	and (17		/buttons assigned to this user
	dac t1
	lac i but
	cma
	and (17		/buttons available
	ior t1		/..or assigned already
	and i io
	sas i io
	jmp abz
	ral 9s		/ok, assign
	dac t2
	lac i aw2
	and (760777
	ior t2
	dac i aw2
	lac t1		/this user's previous assignment
	cma
	and i but	/buttons assigned to other users
	ior i io		/or now assigned this user
	dac i but	/are assigned
	jsp ipc
abz,	jmp .










                
                                
/assign more memory, dismiss memory

amm,	dap amz
	jsp ipc
	lac cc
	sza i
	jmp . 4
	and i act
	sza i
amz,	jmp .
	jsp ipc
	law 177
	and i act
	dac cc
	lac (i
	dip i spc
	lio (016666
	jmp mcr

dmm,	dap amz
	jsp ipc
	and (70000
	sas (i
	jmp . 3
	lac i ill
	dac i xe9
	lac cc
	and i act
	sza i
	jmp amz
	dzm cc
	dip i spc
	lio (066666

mcr,	dio i cr
	dio i idc
	law 2
	and i abf
	sza i
	jmp amz
	law 6
	add i sp2
	jda pfx
	dac iad
	dio i iad
	jmp amz

/memory bound

tmb,	dap tmz
	lio (10000
	lac cc
	and i act
	sza
	lio (20000
	dio i ac
	jsp ipc
tmz,	jmp .







                
                                cc,	0

































































                
                                
/dismiss to MYSTIC

mys,	dap myz
	law 2
	dac i why	/this is a dismiss
	law 4
	and i abf
	sza i
	jsp sw		/user was running
	lac i re
	dac i xe9
	law 7777
	and i kfm
	dac i kfm
	law 2
	and i abf
	ior (1
	dac i abf
	law 0
	dac i pc
	lac (066667
	dac i cr
	lac i d9
	dac i dp
	lac (400000
	dac i qn
	law 45		/MYSTIC running field
	lio i act
	ril 6s
	rcr 6s
	dio i act
myz,	jmp .

sw,	dap swz
	lac ac
	dac t1
	lac i sp2
	jda pfx
	dac t2
swl,	lac i t1
	lio i t2
	dio i t1
	dac i t2
	idx t2
	idx t1
	sas sp2
	jmp swl
swz,	jmp .

















                
                                
/console turned on or off

onf,	dac msk
	jsp rsv
	lac i tsb
	cma
	and i onn
	and msk
	sza
	jmp off		/console turned off
	lac i onn
	cma
	and msk
	and i tsb
	sza i
	jmp sea		/nothing to do


	ior i onn	/console turned on
	dac i onn
	law 1		/start MYSTIC
	dac i abf
	law 45		/MYSTIC running field
	lio i act
	ril 6s
	rcr 6s
	dio i act
	jmp sea

msk,	0



































                
                                
/console turned off

off,	xor i onn
	dac i onn
	dzm i io
	jsp drd		/Dismiss reader,
	jsp dph		/punch,
	jsp dnf		/all fields,
	jsp dx		/external register,
	jsp dxq		/external equipment,
	jsp ak		/knobs,
	jsp ab		/buttons,
	jsp dmm		/extra memory,
	jsp dmm		/extra memory,
	lac i spc	/ID field,
	cli
	rcr 6s
	sza i
	jmp . 4		/(no ID field)
	jda abp
	dzm i abp
	cla
	rcl 6s		/running field.
	sza i
	jmp . 3		/(no running field)
	jda abp
	dzm i abp

	dzm i be		/restore activation variables
	lac msk
	dac i act
	dzm i jfm
	law 76
	dac i kfm

	lio i aw1	/empty console buffer
	law 1
	wat

	law prv		/restore private variables
	dac pvt
	lac ac
	dac pbl
prs,	lac i pvt
	dac i pbl
	idx pvt
	lac i pvt
	spa
	jmp sea
	adm pbl
	idx pvt
	jmp prs

pvt,	0
pbl,	0










                
                                
/table to drive private variable restoration

prv,	0	2	/ac - io clear already
	0	1	/pc
	0	1	/pf
	400000	1	/qn
p9,	0	1	/dispatch = <jmp d9>
	066667	1	/rename
	0	5	/dia
	0	1	/z81
	0	1	/z82
	0	1	/z83
p8,	0	3	/z84 = <jmp ti>
	0	1	/why
	0	1	/abf
	0	2	/spc
p7,	0	1	/xe9 = <jmp re1 1>
p5,	0	2	/rs1 = <jmp re9>
	0	1	/inactive ac
	0	1	/io
	0	1	/pc
	0	1	/pf
	6374	1	/qn
p6,	0	1	/dispatch = <jmp d7>
	066666	1	/rename
	0	27	/dia
	0	1	/breakpoint variables
	0	1
	0	1
	0	1
	0	400000


































                
                                
/last page

t1,	0
t2,	0

	constants

foo,	start

























































                
                                4