                                  
/pdp-1 fortran part 3

/-----
/"sense light" statements
/turn on dummy sense light

sens,	jsp nxtwer
	sas (flexo sel
	jmp stt
	jsp nxtwer
	sas (flexo igh
	jmp stt
	jsp kfm	/kill flt. mode
	jsp nxtwer
	sas (flexo   t
	jmp stt
	jsp nxtwer
	sas (20	/zero
	jmp a
	law msg
	jda ptext
	jmp dochk
msg,	text /jsp cff/
a,	law msg2
	jda ptext
	lac i where
	jda alpha
	law 66	/f
	jda alpha
	law i 7777	/mask = 770000
	and i where
	sza
	jmp lter	/light numeer > 99
	jsp nxtwer
	sad del+13	/c/r
	jmp dochk	/okay
lter,	law 41.	/error 41 = sense light > 99
	jmp bad
msg2,	text /law 1
	dac f/

























                
.                                
/-----
/"assign" statements
/assign i to n

assi,	jsp nxtwer
	sas (flexo ign
	jmp stt
	jsp kfm
	jsp lw	/.law .
	jsp st
back,	jsp nxtwer
	jda number
	jmp a
	lac i where
	jda alpha
	jmp back
a,	law 4033	/middle dot, comma
	jda opcode
	lac (flexo dap
	jda opcode
	cla
	lio i where
	rcl 6s
	rcl 6s
	sad (flexo  to
	jmp .+3
	law 11.	/error 11 = can i t find "to"
	jmp bad
	dio i where
	lac where
	jda define
b,	lac i where
	sad del+13	/c/r
	jmp dochk
	jda alpha
	idx where
	jmp b




























                
                                
/-----
/"if" statements

if,	lac where
	dac temp
	dzm lp
a,	lac i temp
	sad (flexo sen
	jmp yy1+1	/try sense light/switch
	sad del+16	/(
	jmp upit
	sas del+17	/)
	jmp idt
	law i 1
	add lp
	dac lp
	sza i
	jmp yeck
idt,	idx temp
	jmp a

upit,	idx lp
	jmp idt

yeck,	lac temp
	dac final
	idx where
	jsp math
	law 1
	sad iflag
	jmp y
	dzm flm-1	/clear flt. mode flag
	law strm
	jda ptext
y,	law msg1
	jda ptext
	jsp stnom
	lac jps-1
	jda alpha
	lac jps-2
	jda alpha
	jsp stnom
	lac jps-1
	dac store
	lac jps-2
	dac store+1
	jsp stnom
	lac store
	sas jps-1
	jmp notsam
	lac store+1
	sad jps-2
	jmp nodo
notsam,	law msg2
	jda ptext
	lac store
	jda alpha
	lac store+1
	jda alpha






                
0                                	jmp nodo

msg1,	text /
	spa
	jmp st/
msg2,	text /
	sza i
	jmp st/
strm,	text /=>strf
	lfm
	lac strf/

stnom,	dap rtr
	dzm jps-2
	idx final
	lac i final
	dac jps-1
	jda number
	jmp e13
	idx final
	lac i final
	sad del+21	/ ,
rtr,	jmp 0
	sad del+13	/c/r
	jmp rtr
	dac jps-2
	jda number
	jmp e13
	idx final
	lac i final
	sad del+21	/,
	jmp rtr
	sad del+13	/c/r
	jmp rtr
e13,	law 13.	/error 13 = non digit char. in paths of ifstmnt
yy1,	jmp bad	/path of if, i.e., if(i) 1,a,5






























                
4                                
/try sense switch/light
	idx temp
	dac scratch+3	/temp store
	lac i scratch+3
	sad (flexo sel
	jmp slight
	sas (flexo ses
	jmp if +3
	idx scratch+3
	lac i scratch+3
	sas (flexo wit
	jmp if+3
	jsp kfm
	lac scratch+3
	dac where
	jsp nxtwer
	and del+13	/oct 77
	dac scratch
	sub (8.
	sma
	jmp er14
	jsp nxtwer
	sas del+17	/)
	jmp er14
	lac (flexo szs
	jda opcode
	lac scratch
	jda alpha
nxtst,	law swmsg
	jda ptext
a47,	jsp nxtwer
	sad del+21	/,
	jmp .+3
	jda alpha
	jmp a47
	jsp carret
	jmp jps
er14,	law 14.	/error 14 = illegal sw. no. > 7
	jmp bad

swmsg,	text /
	jmp st/

slight,	jsp kfm	/kill flt. mode
	idx scratch+3
	lac i scratch+3
	sas (flexo igh
	jmp if+3
	idx scratch+3
	dac where
	dac rp2
	lio i scratch+3
	cla
	rcl 6s
	sas (23
	jmp .-3
	dio lp2	/light no.
	law litemsg1
	jda ptext






                
>>15<<                                	lac lp2
	jda alpha
	law 66	/f
	jda alpha
	law swmsg
	jda ptext
findoff,	idx rp2
	lac i rp2
	sas del+21
	jmp findoff
	lac del+13	/replace comma  after 1st path with c/r
	dac i rp2
	idx rp2
	lac i rp2
	sad del+13	/c/r
	jmp .+3
	jda alpha
	jmp .-5
	jsp nxtwer
	sas del+17
	jmp er15
	law lt3msg
	jda ptext
	lac lp2
	jda alpha
	law 66	/f
	jda alpha
	jsp carret
	jmp jps

generr,er15,	law 15.	/general (non-specific) error in statement
	jmp bad

litemsg1,	text /law 1
	sas f/


lt3msg,	text /
	dzm f/

	0	/store second half of stmnt no. here
jpsw,	0	/store first half of stmnt no. here
jps,	dzm jpsw-1
	jsp nxtwer
	dac jpsw
	jda number
	jmp e13
	jsp nxtwer
	sad del+13	/c/r
	jmp nodo
	dac jpsw-1
	jda number
	jmp e13
	jsp nxtwer
	sas del+13
	jmp e13
	jmp nodo









                
o                                
/-----
/"end flex" statement
eff,	jsp nxtwer
	sas (flexo   x
	jmp ne1
	dzm flm-1	/out of flt. mode after endflex stmnt
	law endflx
	jda ptext
	jmp dochk
endflx,	text /jsp eff/

ne1,	jsp lstwer
	jmp ne2





/-----
/"end" statement

stm,	text /strf_..laf_..	dec /
stm2,	text /
	0
/
term,	jsp nxtwer
	sad (flexo fle	/check for endflex stmnt
	jmp eff
ne2,	jsp lstwer	/restore where
	law dolist+2
	dac strwrd
	lac dolist-1
	dac word
	dzm scratch
bakup,	lac i strwrd
	sza
	jmp fnd1
	idx strwrd
	idx strwrd
	idx strwrd
	isp word
	jmp bakup
	jmp ahed
fnd1,	law i 2
	add strwrd
	dac tp
	lac i tp
	jda message
	idx tp
	lac i tp
	jda message
	law mesg
	jda ttext
	law 1
	dac scratch
	jmp bakup+3
mesg,	text / unterm. do
/
rerun,	text /	jmp mainprog






                
d                                /

ahed,	law 1
	sas scratch
	jmp .+3
	law 16.	/error 16 = some unterm. do loops
	jmp bad

	lac stmnt
	sza
	jmp peo
	jsp nxtwer
	sad del+13
	jmp fst
peo,	jsp goto-16
	law rerun
	jda ptext
fst,	dzm fg1
	law stm
	jda ptext
	lac lad	/output size of array area
	jda bindec
	law stm2
	jda ptext
	jsp dos	/output blk
	law ilist	/output unsubsc. var. storage
	dac word
loy,	jsp carret
	clf 3
	lac i word
	jda fixed
	stf 3
	lac i word
	sza i
	jmp loz
	jda alpha
	idx word
	lac i word
	jda alpha
	law dts
	jda ptext
	szf i 3
	jmp zom
	law 4033
	jda opcode
	law 7373
	jda alpha
zom,	idx word
	sas define	/inxt
	jmp loy
loz,	jsp carret
	law fcn	/output flt. const.
	dac word
fc1,	sad nct
	jmp fc2
	law 7763	/c/r, c
	jda alpha
	law fcn-1
	sub word
	cma






                
                                	ADD ["
	SAR "S	?DIVIDE BY '
	JDA BINDEC
	LAW FCM"
	JDA PTEXT
	LAC I WORD
	DAC RP'	?TEMPx STORE FOR FLTxPTx ZERO CHECK
	JDA NUMB
	LAW FCM'
	JDA PTEXT
	IDX WORD
	LAC RP'	?CHECK FOR FLTxPTx ZERO
	SZA I
	DZM I WORD
	LAC I WORD
	JDA NUMB
	IDX WORD
	JMP FC"
FCM"=	TEXT ?=	OCT ?
FCM'=	TEXT ?
	OCT ?

FC'=	JSP CARRET
	LAC [FLEXO FIN
	JDA ALPHA
	LIO DEL+22
	jda output
	jsp carret
	law i 20
	jda feed
	lio (13
	jda output
	law i 200
	jda feed
	law typend
	jda ttext
	cla>>05<<cli>>05<<hlt>>05<<clf 7
	jmp .-1
dts,	text /,	0 /
typend,	text /
end
/
























                
>>60<<                                
/-----
/arithmetic statements
arith,	lac where
	dac temp
	jsp idxtmp
	sas del+13	/c/r
	jmp .+3
	law 17.	/error 17 = bad arith stmnt
	jmp bad	/a = c/r  -no stmnt on right of =
	law buffer	/define variable name
	jda define	/after return if "define" is zero variable was flt.,
		/if non-zero was fixed
	jsp math
	clf 5
	law 1
	sas iflag
	jmp fltg
	lac define
	sza
	jmp a
	jsp crtab
	jsp jd
	law msg1
ad1,	jda ptext
	stf 5
a,	jsp name
	jmp dochk

fltg,	lac define
	sza
	jmp fxit	/fixed pt. variable name
	jsp name
	jmp dochk

fxit,	dzm flm-1
	law msg2
	jmp ad1
rpl,	text /=>/
name,	dap retrn
	szf 5
	jmp dcit
	law rpl
	jda ptext
nm2,	law buffer
	dac where
loopit,	lac i where
	sad del+11
retrn,	jmp 0
	sad del+17
	lac del+7
	sad del+16
	lac del+6
	jda alpha
	idx where
	jmp loopit
dcit,	jsp dc
	jmp nm2

msg1,	text /xf






                
l                                	/

msg2,	text /
	jsp ff
	/





























































                
.                                
/-----
/misc. subroutines

sdt,	dap ex
	law 1
	dac bindec-1
ex,	jmp 0

	0
flm,	dap exit
	lac stmnt
	sza
	jmp fltit
	lac flm-1
	sza
exit,	jmp 0
fltit,	law enter
	dac flm-1
	jda ptext
	jmp exit

enter,	text /efm 2
	/

kfm,	dap exit
	lac flm-1
	sza i
exit,	jmp 0
	law leave
	jda ptext
	dzm flm-1
	jmp exit
leave,	text /lfm
	/

/output carriage return
carret,	dap exit
	lio del+13
	jmp put

/output a space
spc,	dap exit
	cli
	jmp put

/output carriage return, tab
crtab,	dap .+3
	law 7736
	jda alpha
	jmp 0

/output tab
tabt,	dap exit
	lio (36
put,	jda output
exit,	jmp 0









                
>>15<<                                
/get the next word from the buffer
nxtwer,	dap .+3
	idx where
	lac i where
	jmp 0
/get the previous word from the buffer
lstwer,	dap .-1
	law i 1
	add where
	dac where
	jmp lstwer-2


/output "st" (used in stmnt. no.)
st,	dap .+3
	law 2223
	jda alpha
	jmp 0


/interchange AC-IO
swap,	0
	dap .+4
	lac swap
	rcr 9s
	rcr 9s
	jmp 0


idxtmp,	dap .+3
	idx temp
	lac i temp
	jmp 0



punch,	jda output



/input subr. (get char. from paper tape or typewriter)
torp,	dap a
	jsp c
	sad (75
	jmp fill	/backspace cancels line
	sad (13
	jmp wait	/stop code, no "end"
a,	jmp 0

c,	dap rtrn
	szs 50
	jmp b
	jsp buf	/get a char. from paper tape
	jmp xx1	/char. in AC
b,	szf i 1
	jmp .-1
	tyi
	clf 1
	jda swap	/swap AC| IO






                
j                                xx1,	and del+13	/oct 77
	sas del+13
rtrn,	jmp 0
	idx linect
	law 77
	jmp rtrn
wait,	error 1	/stop code - no "end"
	dzm buf-1
	jmp fill

























































                
>>76<<                                
typin,	dap a
	jsp torp
	sad (36
	jmp a+1	/filter out tabs
	sza i
	jmp typin+1	/filter out spaces
a,	jmp 0
	lac buffer
	sas (flexo   c
	jmp typin+1
	jmp dec	/fortran comment stmnt

/error returns from compiler
bad,	dac tem
	jsp sdt	/set bindec for tyo output
	jsp typcr
	lac (726551
	jda message
	lac tem
	jda bindec
	law 3643
	jda message
	lac (flexo ine
	jda message
	lac linect
	jda bindec
	jsp typcr
	law 1
	dac output-2	/prevent furthur norm. output
	dzm bindec-1	/set bindec back to norm.output
	jmp fill


































                
	                                
/check for illegal do termination
nodo,	lac stmnt
	sza i
	jmp fill
	lio stmnt+1
	jda dolk
	jmp fill
	law 7.	/error 7 = do terminated by
	jmp bad	/a do, if, stop, or goto



/search dolist for argument in AC-IO
dolk,	0
	dap endolk
	dio tem
	law dolist
	dac sct
doin,	lac donxt
	sad sct
	jmp endolk
	lac i sct
	sas dolk
	jmp doidx
	idx sct
	lac i sct
	sas tem
	jmp doidx2
	idx endolk
	idx sct
endolk,	jmp 0	/returns to +1 if found with addr. of nest count in AC
doidx,	idx sct
doidx2,	idx sct
	idx sct
	jmp doin






























                
q                                
/output an op. code
opcode,	0
	dap xit
	lac opcode
alf,	jda alpha
	jsp spc	/space
xit,	jmp 0

/output three dots, space for decal comments
cmt,	dap xit
	lac (737373
	jmp alf


/output .jmp . instruction
jp,	dap xit
	lac (flexo jmp
	jmp alf


/output .law .instruction
lw,	dap xit
	lac (flexo law
	jmp alf


/output .dac . instr.
dc,	dap xit
	lac (flexo dac
	jmp alf


/output .lac . instr.
lc,	dap xit
	lac (flexo lac
	jmp alf

/output .jda . instr.
jd,	dap xit
	lac (flexo jda
	jmp alf




/scan dolist, if all terminated output "blk"
dos,	dap return
	law dolist+2
	dac tem
	lac dolist-1
	dac tp
loop,	lac i tem
	sza
return,	jmp 0
	idx tem
	idx tem
	idx tem
	isp tp
	jmp loop






                
e                                	jsp carret
	lac (flexo blk
	jda alpha
	jmp return






























































                
4                                
/storage areas

store,	.+2/
scratch,	.+4/
temp,	0
doct,	0
donxt,	0
linect,	0
decl,	0
iflag,	0
strwrd,	0
where,	0
word,	0
upind,	0
lp,	0
lp2,	0
rp,	0
















































                
3                                                                

