PDP-1 fortran


/ERRORS
/er.N       line.J   is typed out where .N is the error type and .J is the line number.

/1	stmnt too long
/2	illegal character
/3	unmatched parenthesis
/4	stmnt no. too long
/5	unrecognized stmnt or stmnt written incorrectly
/6	comma missing after name in assigned go to
/7	do terminated by do, if, stop, or goto
/8	go to N, where N is over 6 digits
/9	not fixed pt. var. name in assigned goto
/10	no comma after right paren. of computed goto
/11	can't find "to" of assign i to n
/12	too many flt. pt. constants
/13	if stmnt has illegal path. non-digit char., or not followed by carriage return
/14	illegal sense switch number   n>7
/15	error in statement - non-specific error
/16	some unterminated do loops
/17	a =     nothing to right of equals in arith stmnt
/18	do terminated previously
/19	too many do's
/20	do 123 a =      a not fixed pt.
/21	variable name too long
/22	only 1 arg. for do     do 123 k=1
/23	comma after 3rd arg. of do
/24	variable name begins with a digit
/25	arg. name not fixed pt.
/26	do terminated already
/27	unnumbered format
/28	bad format   	?
/29	no carriage return after ) in format
/30	no dec.pt. in f field of format
/31	field too big  (max=63)
/32	no format no. in i/o stmnt
/33	var. name too long
/34	too many undimensioned variables
/35	dimension has a stmnt number
/36	variable name ends with f
/37	unsubscripted variable has a subscript
/38	dimensioned var. has no subsc.
/39	subsc. variable hasn't been dimensioned
/40	too many dimensioned variables
/41	error in "sense light" statement (light > 99)
/42	flt. const. too big (up to 10 integer and/or 10 fractional digits)
/43	exp. overflow/underflow in flt. const. routine
/44	arithmetic or "if" statement is mixed mode
/45	illegal subscript in arithmetic or "if" statement
/46	variable name begins with digits

/halts_.
/140001 = stop code (oct 13) read, no "end" statement
/140002 = overflow set at entry to flt. const. routine
/140003 = overflow set during previous statement
/140004 = flt. divide by zero - flt. const. routine
/140005 = mul div switches not on






                
.                                /140006 = negative number being floated (flt.const.routine) = compiler error
/760400 = norm. hlt used for divide check




/if sw. 5 is up the input is from the typewriter, if down from FIO-DEC paper tape

/if sw. 3 is up the stmnt is not listed with the output.



/special characters are stored in single words in the input buffer
/(special characters are non-alphabetic or non-digit characters)
/Upper case characters are stored in complemented form.

/the . is used to indicate a decal insertion

/Brackets [ ] are changed to parentheses ( ) during input packing.

/char. being input are packed so that alphabetic or numeric
/char. are packed into words of up to 3 char. (right justified)
/delimiting char. are in words by themselves.
/The exception to this is the format stmnt. After the word
/format is found all char. are stored in individual words.

/if an "end" stmnt has a stmnt no. and/or anything else on
/the line, except c/r, it will
/cause the stmnt to be typed out, during execution, and
/pushing continue will restart the prog.
/if an "end" stmnt appears by itself on a line it will terminate the compilation and
/output the variable storage.

/dss fltcon typcr number digit fixed feed
/dss del delim output numb buf
/dss bindec message alpha ptext ttext txt define

final=7000
sct=7001
tem=7002
stmnt=7003
tp=7005
dfg=7006
cct=7007
fg1=7010
nct=7011
rp2=7012
fv=7014
fcn=7077
ilist=7244
dolist=7411
buffer=7543














                
>>52<<                                
/prog. 0000-6777

0/
beg,	law fv	/clear storage areas
	dac temp
	dzm i temp
	idx temp
	sas (7777
	jmp .-3

	law i 25.	/set no. of dimensioned var.
	dac fv-1	/2 words each, 7013-7075, 51 words
	dac define-4	/fvc
	law fv
	dac define-3	/fvn

	law i 50.	/set no. of flt. const.
	dac fcn-1	/2 words each, 7076-7242, 101 words
	dac cct
	law fcn
	dac nct

	law i 50.	/set no. of unsubsc. variables
	dac ilist-1	/2 words each, 7243-7407, 101 words
	dac define-2	/ict
	law ilist
	dac define-1	/inxt

	law i 30.	/set no. of do's
	dac dolist-1	/3 words each, 7410-7542, 91 words
	dac doct
	law dolist
	dac donxt

	dzm lad
	dzm linect
	dzm buf-1
	dzm bindec-1	/set bindec for norm. output
	dzm output-2
	dzm jps-1
	dzm flm-1

	law 1	/check to see if mul div switches are .o.n
	mul (74
	div (74
	jmp .+3
	sad (1
	jmp .+3
	error 5
	jmp beg
	jsp txt














                
>>60<<                                
/return to fill to process a new stmnt
fill,	szo
	error 3
	dzm stmnt
	dzm stmnt+1
	dzm decl
	dzm dfg	/dimension flag
	lac glom
	dac chkf-1

/clear the input buffer
	law buffer
	dac where
	dzm i where
	idx where
	sas (7777
	jmp .-3
	clf 7
	dzm upind
	law buffer
	dac where
	jsp carret
wrd,	law i 3
	dac word
	dzm i where
getchar,	law 1
	sad upind
	jmp upper
	jsp typin
	sas (72
	jmp .+3
	dzm upind
	jmp .-4
	sad (74
	jmp upper

som,	dac temp
	szf i 2
	jmp d
	jda delim
	jmp e	/store it
	jmp nyt	/delimited
d,	jda delim
	jmp f	/no
	stf 2
	jmp nyt	/yes

f,	lac temp
	jda digit
	jmp h	/no
	szf 3
	jmp e
	stf 3
	jmp nyt

e,	lac i where
	ral 6s
	add temp
	dac i where	/store char.






                
5                                	isp word
	jmp getchar
	jsp idxwer
	jmp wrd

h,	szf i 3	/in alphabet mode?
	jmp e
	clf 3	/no

nyt,	law i 3
	sas word
	jsp idxwer
	lac temp
	dac i where
	sad del+13	/c/r
	jmp pro	/process
	szf i 2
	jmp .+3
	jsp idxwer
	jmp wrd
	law i 2
	dac word
	jmp getchar


idxwer,	dap edxw
	lac i where	/check for format
	sad (flexo mat
	jmp chkfmt
chkf,	idx where
	sas (7777	/is it end of buffer?
edxw,	jmp 0
	law 1	/error 1 = stmnt too long
	jmp bad

chkfmt,	law i 1
	add where
	dac tem
	lac i tem
	sas (flexo for
	jmp chkf
/it's a format - store in single char. mode
	lac (760000
	dac chkf-1
	idx where
	jsp torp
	dac i where
	sad del+13	/c/r
	jmp lstfm
	jsp idxwer
	jmp .-5
/list a format
lstfm,	jsp kfm	/kill flt. mode
	law buffer
	dac tp
	szs i 30
	jsp cmt	/3 dots, space (decal comment)
xq,	lac i tp
	szs i 30
	jda alpha






                
2                                	lac i tp
	sad (flexo mat
	jmp .+3
	idx tp
	jmp xq
	idx tp
xr,	lio i tp
	szs i 30
	jda output
	lac i tp
	sad del+13	/c/r
	jmp chk
	idx tp
	jmp xr

glom,	jmp chkfmt

upper,	jsp typin
	sas (72
	jmp .+3
	dzm upind
	jmp getchar

	sad (20
	jmp dins	/. = decal insert
	cma
	dac temp
	jda delim
	jmp illeg	/illegal upper case char.
	law 1
	dac upind	/legal upper case char.
	lac temp
	sad del+6	/replace brackets with parens.
	lac del+16
	sad del+7
	lac del+17
	dac temp
	jmp som+1

dins,	law buffer
	sad where	/. must be first char. to be legal decal insert
	jmp dec-1
illeg,	szs i 50
	jmp ad2
	idx linect
ad1,	law 2	/error 2 = illegal char.
	jmp bad
ad2,	jsp torp	/if paper tape read rest of line
	sas del+13	/c/r
	jmp ad2
	jmp ad1


/list the line and check for matched parens.
pro,	dzm lp
	dzm rp
	lac where
	dac final	/final contains addr. of c/r in buffer
	lac buffer
	sad del+13	/c/r






                
0                                	jmp fill	/redundant c/r
	szs i 30	/no list if sw.3 on
	jsp cmt	/3 dots, space
	law buffer
	dac where
char,	lac i where
	sas del+16	/(
	jmp .+3
	idx lp
	jmp rr1
	sas del+17	/)
	jmp .+3
	idx rp
	jmp rr1
	sad del+13	/c/r
	jmp out
rr1,	lac i where
	szs i 30
	jda alpha
	idx where
	jmp char




out,	jsp carret
	lac lp	/do parentheses match?
	sad rp
	jmp chk
	law 3.	/error 3 = unmatched parens.
	jmp bad
chk,	law 1
	dac fg1	/set first output flag




/check for stmnt no.
	lac buffer
	jda number
	jmp nope
	lac buffer
	dac stmnt
	dzm buffer

	lac buffer+1
	jda number
	jmp nope
	lac buffer+1
	dac stmnt+1
	dzm buffer+1

	lac buffer+2
	jda number
	jmp nope
	law 4	/error 4 = stmnt no. too long
	jmp bad









                
>>15<<                                

/check for type of stmnt
nope,	law buffer
	dac where
stt,	lac i where
	sad (flexo end
	jmp term
	sad (flexo sto
	jmp stop
	sad (flexo con
	jmp cont
	sad (flexo pri
	jmp print
	sad (flexo rea
	jmp read
	sad (flexo pun
	jmp write
	sad (flexo acc
	jmp ti
	sad (flexo typ
	jmp to
	sad (flexo got
	jmp goto
	sad (flexo ass
	jmp assi
	sad (flexo pau
	jmp paus
	sad (flexo for
	jmp form
	sad (flexo  if
	jmp if
	sad (flexo  do
	jmp do
	sad (flexo sen
	jmp sens
	sad (flexo dim
	jmp dime
	sad del+11
	jmp arith	/=
	sad (flexo fee
	jmp fdf	/feed flex
	sas del+16	/(
	jmp .+5
	jsp nxtwer	/find matching ) and then resume scan
	sas del+17
	jmp .-2
	jmp them
	jda delim
	jmp them
	law 5
	jmp bad	/error 5 = unrecognized stmnt

them,	idx where
	jmp stt











                
>>14<<                                
/-----
/decal insert or fortran comment
	stf 4	/decal insert
dec,	lac (737373 /flag 4 not set for fortran comment
	dac decl
	law buffer
	dac where
	dac tp
	jsp torp
	sad (72
mode,	jsp torp
	dac i where
	sad del+13	/c/r
	jmp dd
	idx where
	jmp mode
dd,	szf i 4	/if flag 4 is on it is a decal insert
	jmp .+5
	jsp kfm	/kill flt. mode (decal insert)
	law 1
	dac fg1	/set first output flag
	jmp c
	jsp cmt
	law 6336
	jda alpha
c,	lac i tp
	sad del+13
	jmp fill
	jda swap
	jda output
	idx tp
	jmp c

































                
                                 
/-----
/process a do stmnt
do,	jsp nxtwer
	jda number
	jmp stt	/not a do
	jsp kfm
	dzm store
	clf 2
	lac i where
	dac scratch
	dzm scratch+1
	jsp nxtwer
	jda number
	jmp lkup
	lac i where
	dac scratch+1
	idx where
lkup,	lac scratch
	lio scratch+1
	jda dolk
	jmp notlst
	dac temp
	idx i temp
	dac scratch+2
	sas (1
	jmp numfin
	law 18.	/error 18 = do term. previously
	jmp bad

/add do no. to dolist
notlst,	isp doct
	jmp ab
	law 19.	/error 19 = too many do's
	jmp bad
er20,	law 20.	/error 20 = do 123 abc (not fixed pt.)
	jmp bad

ab,	lac scratch
	dac i donxt
	idx donxt
	lac scratch+1
	dac i donxt
	idx donxt
	law 1
	dac i donxt
	dac scratch+2
	idx donxt
/do stmnt no. in scratch, scratch+1
/nest count in scratch+2

numfin,	lac i where
	jda fixed
	jmp er20
	lac where
	dac scratch+3
	law buffer+100	/temporary storage
	dac store
	dac strwrd
	law i 6






                
                                	dac word
yes,	lac i where
	dac i store
	idx store
	jsp nxtwer
	sad del+11	/=
	jmp setup
	isp word
	jmp yes
	law 21.	/var. name too long
	jmp bad

er22,	law 22.	/error 22 = do 123 k=12
	jmp bad	/only 1 argument for do

setup,	jsp dovar	/get first variables name
	jmp er22
	jsp donumb	/output do1234n1 blk symbol
	law 22	/s
	jda alpha
	lac (407336
	jda alpha
	jsp dc	/.dac .
	law i 6
	dac word
	lac i strwrd
	jda alpha
	idx strwrd
	isp word
	jmp .-4
	stf 2
	clf 3	/get 2nd variables name
	jsp crtab
	jsp dovar
	stf 3	/c/r
	szf 2
	jmp c	/var.2 was a number
	jsp tabt
	jsp dc	/.dac .
	jsp donumb
	law 5401	/-1
	jda alpha
	jsp crtab
c,	clf 2
	szf 3
	jmp strem
	jsp dovar	/get 3rd var. name
	jmp srit
	law 23.	/error 23 = , after 3rd arg.
	jmp bad

srit,	jsp tabt
	jsp dc	/.dac .
	jsp donumb
	jsp crtab
strem,	law msg47
	jda ptext
	law 1
	sad store	/was 2nd var. a number
	jmp d	/yes






                
3                                	law 7373
	jda alpha
	jsp carret
f,	jsp donumb
	lac (407336	/middle dot, period, tab
	jda alpha
	lac (737301	/period, period, one
	jda alpha
	lac scratch+3
	jda define
	jmp nodo


d,	lac (flexo dec
	jda opcode
	lac i upind
	sad del+21
	jmp e
	sad del+13	/c/r
	jmp e
	jda alpha
	idx upind
	jmp d+2
e,	jsp carret
	jmp f

msg47,	text /jmp .+3
	/

/set up a do var. name, i.e.,    =2,n,-5
/returns to +1 if ended with a comma
/norm. return if a c/r

dovar,	dap return
	clf 5
	jsp nxtwer
	sas del+20	/-
	jmp labl
	jsp nxtwer
	jda number
	jmp nmno	/not a minus no.
	szf 2
	jmp patch-3
	lac (flexo ndi
	jmp bksom-3

nmno,	stf 5
labl,	lac i where
	jda number
	jmp notno
	szf 2
	jmp patch
	lac (flexo pdi
	jda opcode
	lac i where
	jda alpha
bksom,	jsp nxtwer
	sas del+21	/,
	jmp .+3
	idx return






                
>>15<<                                	jmp exit
	sad del+13	/c/r
	jmp exit
	jda number
	jmp er24
	lac i where
	jda alpha
	jmp bksom
er24,	law 24.	/error 24 = var. name begins with number
	jmp bad
er25,	law 25.	/error 25 = arg. name not fixed pt.
	jmp bad

notno,	clf 2
	jsp lc	/.lac .
	lac i where
	jda fixed
	jmp er25
	lac i where
	jda alpha
ad1,	jsp nxtwer
	sas del+21	/,
	jmp .+3
	idx return
	jmp exit
	sad del+13	/c/r
	jmp exit
	jda alpha
	jmp ad1

exit,	jsp carret
	szf i 5
return,	jmp 0
	jsp tabt
	lac (flexo cma
	jda alpha
	clf 5
	jmp exit

/output st12n1	stmnt.no.in scratch, scratch+1
/		,nest count in scratch+2
donumb,	dap vv3
	jsp st
	lac scratch
	jda alpha
	lac scratch+1
	jda alpha
	law 45	/n
	jda alpha
	lac scratch+2	/nest count
	jda numb
vv3,	jmp 0

	law i 1
	add where
	jmp .+2
patch,	lac where
	dac upind
	law 1
	dac store






                
a                                av,	jsp nxtwer
	sas del+21
	jmp .+3
	idx return
	jmp return
	sas del+13	/c/r
	jmp av
	jmp return





/check a stmnt to see if it is on the do list
dochk,	lac stmnt
	lio stmnt+1
	dac scratch
	dio scratch+1
	jda dolk
	jmp fill	/not on list
	dac strwrd
	lac i strwrd	/nest count
	dac scratch+2
	sza
	jmp loopd
	law 26.	/error 26 = do term. previously
	jmp bad

loopd,	law 1	/no c/r-tab if stmnt is continue
	sas cont-1	/continue flag
nst,	jsp crtab
	dzm cont-1
	jsp lw
	jsp donumb
	jsp crtab
	jsp jd
	law dort
	jda ptext
	jsp lc
	jsp donumb
	law 22
	jda alpha	/s

	law i 1
	add scratch+2
	dac scratch+2
	dac i strwrd	/nest count
	sza
	jmp nst	/nested do i s terminate on one stmnt
	jsp dos
	dzm flm-1	/kill flt. mode
	jmp fill
dort,	text /dof
	/












                
>>15<<