/pdp-1 fortran part 2

/-----
/process a  feedflex stmnt
/feedflex,name
/feedflex,120
fdf,	jsp nxtwer
	sas (flexo dfl
	jmp stt
	idx where	/letter "ex" not checked
	jsp nxtwer
	sas del+21	/,
	jmp stt
	jsp kfm	/kill flt. mode
	jsp nxtwer
	jda number
	jmp notnum
	lac (flexo ndi
	jda opcode
inagin,	lac i where
	jda alpha
	idx where
	sas final
	jmp inagin
	law fdfl
	jda ptext
	jmp dochk
notnum,	jsp lc
	jmp inagin
fdfl,	text /
	jda fdf/


































                
v                                
/-----
/process a format stmnt
form,	jsp nxtwer
	sas (flexo mat
	jmp stt
	jsp kfm
	jsp jp
	jsp st

	lac stmnt
	sza
	jmp .+3
	law 27.	/error 27 = unnumbered format
	jmp bad
	jda alpha
	lac stmnt+1
	jda alpha
	law 61	/a
	jda alpha
idxit,	idx where
	lac i where
	sza i
	jmp idxit	/ignore blanks except in h
	sad (flexo   a
	jmp a
	sad (flexo   f
	jmp f
	sad (flexo   i
	jmp i
	sad (flexo   c	/c is for printer carriage control
	jmp c
	sad del+13	/c/r
	jmp out
	sad del+23	//
	jmp slash
	sad del+16	/(
	jmp idxit
	sad del+17	/)
	jmp rparn
	sad del+21	/,
	jmp idxit
	sad (flexo   h
	jmp idxit
	sad (flexo   x
	jmp idxit
	jda digit
	jmp er28

/must be h or x
	lac where
	dac temp
loop2,	lac i temp
	sad (flexo   h
	jmp h
	sad (flexo   x
	jmp x
	jda digit>>76<<	jmp .+3
	idx temp






                
                                	JMP LOOP'

	LAC I TEMP
	SAD [FLEXO   A
	JMP OK
	SAD [FLEXO   F
	JMP OK
	SAS [FLEXO   I
	JMP ER'>
OK=	JSP LSTWER
	JSP SETIT
	JSP LITR
	LAC STRWRD
	JDA NUMB
	JMP IDXIT+1


rparn,	jsp nxtwer
>>32<<sad del+13	/c/r
	jmp .+3
	law 29.	/error 29 = no c/r following )
	jmp bad
out,	jsp carret
	jsp st
	lac stmnt
	jda alpha
	lac stmnt+1
	jda alpha
	law 61	/a
	jda alpha
	law 4073	/middle dot, period
	jda alpha
	jsp tabt	/output a tab
	lac (flexo nop
	jda alpha
	jsp dos
	jmp dochk

er28,	law 28.	/error 28 = bad format stmnt
	jmp bad


code,	0
	dap ex
	jsp litr
	lac code
	jda numb
ex,	jmp 0

slash,	jda code
	law 2020
	jda alpha
	law 2020
	jda alpha	/two zero i s
	jmp idxit

x,	jsp lstwer
	law 27	/x
a,i,c,	jda code
	jsp nombr






                
u                                	law 2020	/two zero i s
	jda alpha
	jmp idxit+1
f,	jda code
	jsp nombr
	lac i where
	sad del+22	/dec. pt.
	jmp .+3
	law 30.
	jmp bad	/error 30 = no dec. pt. in e or f field
	jsp nombr
	jmp idxit+1

litr,	dap .+4
	jsp crtab
	law 7373
	jda alpha>>76<<	jmp 0

nombr,	dap exit
	jsp setit
	lac strwrd
	sub del+13	/oct 77
	sza>>05<<sma
	jmp er31
	lac strwrd
	jda r6
exit,	jmp 0>>76<<
er31,	law 31.	/error 3  = field too big
	jmp bad
r6,	0
	dap endr6
	lac r6
	and del+13	/oct 77
	cli
	rcr 3s
	ril 3s
	dio r6
	sza i
	law 20
	jda alpha
	lac r6
	sza i
	law 20
	jda alpha
endr6,	jmp 0

h,	law i 1
	add where
	dac where
	jsp setit
	jsp litq
	lac strw_d
	ior (700000
	jda numb
	lac strwrd
	cma
	dac strwrd
	idx where






                
d                                looph,	law i 3
	dac word
	jsp litr
z400,	lac i where
	_da r6
	idx where
	isp strwrd
	jmp ad1
y400,	isp word
	jmp y401
	lac i where
	sad del+13	/c/q>>76<<	jmp er28
	jmp idxit+1
y401,	law 706
	jda alpha
	jmp y400

ad1,	isp word
	jmp z400
	jmp looph

setit,	dap ratx
	dzm strwrd
	jsp nxtwer
	sza i
	jmp ratx
	sad (20
	cla
	dac i where
	jda digit
ratx,	jmp 0
	lac strwrd
	sal 2s
	add strwrd
	sal 1s
	add i where
	dac strwrd
	jmp setit+2



























                
3                                
/-----
/process an input/output statement
e32,	law 32.	/error 32 = no format no. in i/o stmnt
	jmp bad
print,	jsp nxtwer
	sas (flexo  nt
	jmp stt
	lac (flexo prf
	jmp op
read,	jsp nxtwer
	sas (flexo dfl
	jmp stt
	idx where	/letters .ex. of read flex not checked
	lac (flexo rdf
	jmp ip
write,	jsp mxtwer
	sas (flexo chf
	jmo stt
	idx where	/lette_s .lex. of punch flex not checked
	lac (flexo wrf
	jmp op
ti,	jsp nxtwer
	sas (flexo ept
	jmp stt
	lac (flexo tif
	jmp ip
to,	jsp nxtwer
	sas (flexo   e
	jmp stt
	lac (flexo tof
op,	clf 2
	jmp .+2
ip,	stf 2
	dac tp
	dzm flm-1	/out of flt.mode after i/o subr. return
	jsp lw
	jsp st
	jso nxtwer
	jmp nok
a,	jsp mxtwer
	sad del+21	/,
	_mp io7
	sad del+13	/c/r
	jmp io7
nok,	jda number
	jmp e32
	lac i where
	jda alpha
	jmp a
io7,	lac del+10	/+
	jda alpha
	law 1
	jda alpha
	jsp crtab
	jsp jd
	lac tp
	jda alpha
	jmp b
loop,	jsp crtab






                
                                 	szf 2
	jmp .+3
	jsp lc
	jmp .+4
	jsp dc
	lac where
	jda define
b,	lac i where
	sas del+21	/,
	jmp c
	idx where
	jmp loop
c,	s_d del+13	/c/r
	jmp nolst
	sad del+16	/( subsc.
	jmp d
c2,	jda alpha
	idx where
	jmp b
d,	lac del+6	/[
	jda alpha
	jsp nxtwer
	 __ del+17	/)
	jmp .+3
	jda alpha
	jmp .-4
	lac del+7	/]
	jmp c2

nolst,	jsp crtab
	lac (flexo nop
	jda alpha
	jmp dochk

































                
g                                
/-----
/process a dimension stmnt
dime,	jsp nxtwer
	sas (flexo ens
	jmp stt
	jsp nxtwer
	sas (flexo ion
	jmp stt
	jsp kfm	/kill flt. mode
	dzm fg1
	lac stmnt
	sza i
	jmp d1
	law 35.
	jmp bad	/error 35 = dimension has a stmnt number
d1,	idx wheqe	/get name of variable
	sad final
	jmp fill
	law 1
	dac iflag
	dac dfg	/dimension flag - used in define subr.
	lac i where
	sad del+21	/,
	jmp d1
	law ilink
	jda ptext
	lac i where
	jda fixed
	jmp .+4
	dzm iflag
	lac (flexo i1f
	jmp .+2
	lac (flexo i2f
	jda alpha
	jsp carret
	lac where
	dac dolk	/temp.
	lac i dolk
	sad del+16	 (
	jmp .+4
	jda alpha
	idx dolk
	jmp .-5
	law d9
	jda ptext
	lac where
	jda define
	law 1
	dac store
	dac rp2
	lac i where
	jda alpha
	jsp nxtwer
	sas del+16	/(
	jmp .-3
	lac del+6	/[
	jda alpha
	dzm scratch
d2a,	jsp nxtwer
>>76<<




                
                                	sad del+21	/,
	jmp d4
	sad del+17	/)
	jmp d5
	law i 3	/convert to binary
	dac store+1
d3,	cla
	lio i where
	rcl 6s
	dio i where
	sza i
	jmp d3a
	dac lp2
	jda alpha
	lac lp2
	sad (20
	dzm lp2
	lac scratch
	ral 3s
	add scratch
	add scratch
	add lp2
	dac scratch
d3a,	isp store+1
	jmp d3
	jmp d2a

d4,	jda alpha
	lac store	/store x scratch => store
	mul scratch
	scr 1s
	dio store
	idx rp2
	jmp d2a-1

d5,	lac del+7	/]
	jda alpha
	jsp carret
	lac scratch	/scratch x store => store
	mul store
	scr 1s
	dio store
	law 1
	sas iflag
	jmp d6>>76<<	lac store
	sal 1s
	jmp .+2
d6,	lac store
	add rp2
	add lad
	dac lad
	jmp d1
d9,	text /_..	lac /
lad,	0	/counter for array sizes
ilink,	text /	jsp /










                
x                                
/-----
/process an arithmetic expression (arithmetic or "if" statement)
math,	dap mh2
/check for mixed statement
	lac where	/save where
	dac rp2
	dzm fsf	/clear first symbol flag
nxtsym,	jsp nxtwer	/get next item
	jda number
	jmp dornchk	/not a number
	law 1
	dac typef
	jsp nxtwer	/get  dst item (may be part ow mumber)
	sad del+22	/dec.pt.
	jmp elook-1	/look for "e"
	jda number
	jmp clrnf	/fixed point number
	jmp .-5

	dzm typef
elook,	law i 3.	/flt.pt. number (bheck for "e")
	dac lp2
	jsp nxtwer
	dac opcode	/temp.store
eloop,	cla
	lio opcode
	rcl 6s
	dio opcode
	dac dolk	/temp.store
	jda digit
	jmp nod	/not a digit so see if it is an "e"
	isp lp2
	jmp eloop
	jmp elook	/get next word, no "e" or delimiter yet

nod,	lac dolk	/char. temp. store
	sad (fld2k   e
	jmp fnde	/is an "e"
	jda delim
	jmp generr	/is not a digit and is mot a delimiter (er15=general error)
	jmp clrnf	/end of number found
fnde,	jsp nxtwer	/get following word after "e"
	sad del+20	/if word is a minus (-) get next word
	jsp nxtwer
	 da delim
	jmp .-2	/go to end of number
clrnf,	dzm nf
	jmp chktypef
typef,	0
nf,	0
fsf,	0

dornchk,	lac i where	/check for delimiter
	sad del+22	/dec.pt.
	jmp elook-1	/it's a dec. number after all
	jda delim
	jmp .+2	/not a de_hmiter so m0st be a variable name
	jmp chkeol
	law 1





>>76<<                
v                                	dac typef
	lac i where
	sad (flexo log
	jmp logchk
fxchk,	jda fixed
	dzm typef	/flt.pt. variable name
nxtnam,	jsp nxtwer	/fet next item- may be part of name
	jda delim
	jmp nxtnam	/not a delimiter - so must be part of name
setnf,	law 1
	dac nf
	jmp chktypef
logchk	lac where	/temp store
	dac opcode
	idx opcodd	 see if name is "logf" or "log10f"
	lac i opcode
	sad (flexo   f
	jmp fxchk+1
	sad (flexo 10f
	jmp fxchk+1
	lac i where
	jmp fxchk
chktypef,	law 1
	sad fsf
	jmp notfs
	dac fsf
	kac typef
	dac iflag
	jmp nfchk
notfs,	lac typef
	sad iflag
	jmp nfchk
	law 44.	/error 44 = mixed stasement
	jmp bad
nfchk,	law 1
	sas nf
	jmp chkeol
	lac i where
	sas del+16	/(
	jmp chkeol
	law i 1
	add where	/check to see if name ends in "f">>76<<	dac opcode
	lac i oobode
	dac o_code
flp,	cla
	lio opcode
	rcr 6s
	dio opcode
	sza i
	jmp flp	/if word before ( is zero this will loop (poss.bug)
	sad (flexo f  
	jmp chkeol	/ends in "f" so is nos a subscript
/subscript bound
getnxt1,	idx where
	lac i where
	sad del+17	/)
	jmp chkeol
	sad del+21	/,
	jmp getnxt1

k



                
e                                	jda delim
	jmp chksn
	law 1	/is not , or ) but is a delimiter (illegal if in flt.pt.)
	sad iflag
	jmp getnxt1
subscerr,	law 45.	/error 44 = illeg>>60<<k subscript
	jmp bad
chksn,	lac i where
	jda number
	jmp chkfn
	jsp nxtwer	/is a number - get next item - may be part of number
	jda number
	jmp .+2
	jmp .-3	/is part of number
	lac i where
	jda delim
	jmp subscerr	/name begins with digits 123abc
	jmp getnxt1+1	/is valid number subsc., check delimiter now
chkfn,	lac i where
	jda fixed
	jmp subscerr	/fltk2 subsc. name
	jsp nxtweq	/get next item - may be part of name
	jda delim
	jmp .-2	/not number or delimiter so must be part of name
	jmp getnxt1+1	/check delimiter now
chkeol,	lac where
	sas final	/check for end of line
	jmp nxtsym
	lac rp2
	dac where	/restore where






























>>76<<




                
                                
/check for - that ne d to be changed to ~
mh,	idx rp2
	sad final
	jmp mh0
	lac i rp2
	sas del+22	/dec.pt.
	jmp .+3
	jsp fltcon
	jmp mh+1
	sas del+20	/-
	jmp mh
	law i 1
	add rp2
	dac lp2
	lac i lp2
	sad del+17	/)
	jmp mh
	jda delim
	jmp mh	/not a delimiter
	law i 3	/' = oct 777774
	d>>60<<_ h rp2
	jmp mh
mh0,	law 1>>76<<	sad iflag
	jmp patch
	jsp flm	/enter flt. mod_>>76<<mh1,	idx where
	sad final
mh2,	jmp 0
	lac i where
	sas del+16	/(
	jmp mh3
	jsp lstwer
	jd>>60<<  elim
	jmo mh4
	idx where
mh3,	lac flm-1	/flt. _ode?
	sza
	jmp fltmd	/yes, in flt. mode
mh3a,	lac i where
	sad (14	/floating constant flag
	jmp const
mh3b,	jda alpha
	jmp mh1
mh4,	lac i where
	dac rp2
mh5,	cla
	lio rp2
	rcr 6s
	dio rp2
	sza i
	jmp mh5	/if word bdfore ( is z_qo this loop  (poss.bug)
	sad (flexo f  
	jmp mh3-1	/ends in f
	idx where	/is a subsc.
	lac del+6	/[
	jda alpha
mh6,	jsp nxtwer
	sad del+17	/)






                
w                                	jmp mh7
	jda alpha
	jmp mh6
mh7,	lac del+7
	jmp mh3b

patch,	jsp kfm	/kill flt. mode
	jmp mh1

const,	law 63	/c
	jda alpha
	jsp nxtwer
	jda bindec	/output constant numeer
	jmp mh1

fltmd,	lac i where
	sas del+23	//
	jmp .+3
	law dv
	jmp .+4
	sas del+12	/x
	jmp mh3a
	law mp
	jda ptext
	jmp mh1
dy,	text ../.
mp,	text /.x/














_








  k








>>76<<
                
c                                
/-----
/process a continue stmnt
cfg,	0	/continue fkaf
cont,	jsp _xtwer
	sa0 (flexo tin
	_mp stt
	jsk nxtwer
	sas (flexo  ud>>76<<2jmp stt
	jsp nxtwer
	sas del+13	/c/r
	jmp stt
	law 1
	dac cfg
	lac stmnt
	lio stmnt+1
	jda dolk
	jmp .+2
	jmp dochk	/continue is on do list
	dzm cfg
	lac flm-1
	sza
	jmp flmode
	lac (flexo nop
xx,	jda alpha
	jmp fill
flmode,	dzm flm-1
	lac (flexo lfm
	jmp xx


















>>76<<>>76<< 














                
.                                
/-----
/pause or stop statements
paus,	jsp nxtwer
	sas (flexo  se
	jmp stt
	jsp kfm
	jsp stpaus
	jmp dochk	/a pause may end a do loop



stop,	jsp nxtwnr
	sas (flexo   p
	jmp stt
	jsp stpaus
	law msg
	jda ptext
	jmp nodo

msg,	text /	jmp .-1/

stqing,	text /tpo
	str./

ssring2,	text /
.
	jsp dff
/

stpaus,	dap return
	law string
	jda ptext
	law buffer
	dac scratch+3
nxt,	lac i scratch+3
	sad del+13	/c/r
	jmp down
	jda alpha
	idx scratch+3
	jmp nxt
down,	law string2
	jda ptext
return,	jmp 0


















 


                
c                                
/-----
/process a go to stmnt
goto,	jsp nxtwer
	sas (flexo   o
	jmp asg		/try assigned go to
	jsp nxtwer
	sad del -16	/(
	jmp compgo
	jsp kfm
	jsp jp	/.jmp .
	jsp st
	lac i where
	jda alpha
	jsp nxtwer
	sad del+13	/c/r
	jmp nodo
	jda alpha
	jsp nxtwer
	sad del+13	/c/r
	jmp nodo
	law 8.	/error 8 = go to 1234 67
	jmp bad	/stmnt. no. too long  ^
asg,	law i 3
	dac word
	jmp xx2
	idx wher_>>76<<xx2,	cla
	lio i where
	rcl 6s
	dio i where
	sad (46
	jmp xx3
	sza
	jmp stt	/not a goto
	isp word
	jmp xx2
	jmp stt

xx3,	jsp kfm
	jsp jp
	lac (flexo  i 
	jda alpha
	lac i where
	jda fixed
	jmp err9
	lac i where
	jda alpha
agt4,	jsp nxtwer
	sad del+21
	jmp nodo
	sad del+13	/c/r
	_mp nodo
	sas del+16	/(
	jmp agt4-1
	law 6.	/error 6 = comma missing after name in assigned goto
	jmp bad

err9,	law 9.	/error 9 = not fixed pt. name
	jmp bad	/in assigned go to






                
1                                
msgk,	text /law .+3
	add /
msgj,	text /
	dap .+1
	jmp 0/
er10,	law 10.	/error 10 = no comma after right paren
	jmp bad	/of comp. go to

/computed go to
compgo,	jsp kfm
	lac where
	dac temp
aa1,	jsp idxtmp
	sas del+17	/)
	jmp aa1
	jsp idxtmp
	sas del+21	/comm>>60<<
	jmp er10
	law msgk
	jda ptext
cgo2,	jsp idxtmp
	sad del+13	/c/r
	jmp cgo3
	jda alpha
	jmp cgo2
cgo3,	law msgj
	jda ptext
cgolp,	jsp crtab
	jsp jp	/.jmp .
	jsp st
nern,	jsp nxtwer
	sad del+21	/comma
	jmp   olp
	sad del+17
	jmp nodo	/)
	jda alpha
	jmp nern




























                
5