/ PDP-8 (8K) FORTRAN COMPILER	*** FORT.05 ***

/ OCTOBER 28, 1970

/ COPYRIGHT 1969, DIGITAL EQUIPMENT CORP. MAYNARD, MASS.
/
/ SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8)
/ FOR USE WITH DISK/DECTAPE MONITOR SYSTEM
/  CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN
/ SAVE ON THE DISK AS FOLLOWS:
/
/	SAVE FTC0!0-7577;5363<C/R>
/	SAVE FTC1!200,1000-1577,2600,6000-16377;<C/R>
/
/ CALL FTC1 FIRST, THEN CALL FTC0 TO COMPILE
/ FOR SUBSEQUENT COMPILATIONS ONLY CALL FTC0.

	FIELD	0
	*200
INBUF,	TEXT /PDP-8 FORTRAN DEC-08-A2B1-4/

	*1000
BEGIN,	PLS		/INITIALIZATION ROUTINE
	TLS
	RFC
	CDF	00
	TAD	CM1300	/SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1)
	DCA	INDX
	TAD	BSYMP
	DCA	TPTT
LP,	DCA I	TPTT
	ISZ	INDX
	JMP	LP
	TAD	CM60
	DCA	INDX
	TAD	BTTAB
	DCA	TPTT
	DCA I	TPTT	/ZERO OUT TEMPORARY TABLES IN FIELD 0
	ISZ	INDX
	JMP	.-2
	CDF	10
	TAD	MIN104	/ZERO EVERYTHING FROM ZERO TO 107
	DCA	INDX
	TAD	CP6
	DCA	TPTT
LPP,	DCA I	TPTT
	ISZ	INDX
	JMP	LPP
	TAD	TPT	/MOVE DATA FROM TABLE TO FIELD 0
	DCA	TPTT
REP,	CDF	00
	TAD I	TPTT
	SNA		/END OF FIELD 0 INITIALIZATION?
	JMP	DN	/YES
	DCA	LOC
	TAD I	TPTT
	CDF	10
	DCA I	LOC
	JMP	REP
DN,	TAD I	TPTT	/MOVE DATA FROM TABLE TO FIELD 1
	SNA		/END FIELD 1 INITIALIZATION
	JMP	DNN	/YES
	DCA	LOC
	TAD I	TPTT
	DCA I	LOC
	JMP	DN
DNN,	CIF	10
	JMP I	STRT
LOC,	0
INDX,	0
MIN104,	L7-ASSIGN
CP6,	L7-1
CM1300,	-1300
CM60,	-60
BTTAB,	ITTAB-1
BSYMP,	BSYM-1		/BOTTOM OF TEMPORARY SYMBOL TABLE
STRT,	FORST		/STARTING POINT AFTER INITIALIZATION
TPTT=10
TPT,	TABLE-1
TABLE,
PUNCH
	LTTYPE
15
	DOEND
45
	FTTAB
51
	ITTAB
47
	TSYM-3
50
	TSYM
55
	-25
56
	BSYM
57
	BSYM
71
	5777
74
	3000
MIKE4
	3377
POINTZ
	3377
BASE
	INBUF
BASE2
	INBUF+100
SCOUNT
	0
SCOUNT+1
	0
SCOUNT+2
	0
QONE
	0
QONE+1
	0
QONE+2
	0
QONE+3
	0
QONE+4
	0
QONE+5
	0
QONE+6
	0
0		/THIS TERMINATES FIELD ZERO INITIALIZATION
2375
	4000
2376
	4000
2377
	4000
0

/	ERROR MESSAGE TABLE AND TEXT

ELIST,	-ERR1-1;  EMSG1	/ILLEGAL CONTINUATION
	-ERR2-1;  IE	/ILLEGAL ARITHMETIC EXPRESSION
	-ERR3-1;  IE
	-ERR6-1;  IE
	-ERR9-1;  EMSG3
	-ERR10-1; EMSG4
	-ERR12-1; EMSG4
	-ERR14-1; EMSG4
	-ERR15-1; EMSG3
	-ERR16-1; EMSG5
	-ERR17-1; EMSG6
	-ERR18-1; SE	/SYNTAX ERROR
	-ERR28-1; SE
	-ERR29-1; SE
	-ERR30-1; EMSG8  /ILLEGAL VARIABLE
	-ERR31-1; SE
	-ERR35-1; SE
	-ERR37-1; CE
	-ERR38-1; EMSG9  /ILLEGAL DO NESTING
	-ERR39-1; SE
	-ERR40-1; IE
	-ERR41-1; EMSG10  /EXPRESSION TOO BIG
	-ERR42-1; IE
	-ERR43-1; EMSG11  /MIXED MODE
	-ERR44-1; EMSG9
	-ERR48-1; SE
	-ERR50-1; SE
	-ERR51-1; SE
	-ERR52-1;IE
	-ERR53-1; EMSG12  /ILLEGAL SUBSCRIPT
	-ERR54-1; EMSG13  /ILLEGAL EQUIVALENCING
	-ERR59-1; SE
	-ERR60-1; EMSG3
	0;	  EMSG14  /COMPILER MALFUNCTION

EMSG1,	TEXT /ILLEGAL CONTINUATION/
IE,	TEXT /ILLEGAL ARITHMETIC EXPRESSION/
EMSG3,	TEXT /ILLEGAL STATEMENT/
EMSG4,	TEXT /ILLEGAL CONSTANT/
EMSG5,	TEXT /ILLEGAL STATEMENT NUMBER/
EMSG6,	TEXT /SYMBOL TABLE EXCEEDED/
SE,	TEXT /SYNTAX ERROR/
EMSG8,	TEXT /ILLEGAL VARIABLE/
EMSG9,	TEXT /ILLEGAL OR EXCESSIVE DO NESTING/
EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/
EMSG11, TEXT /MIXED MODE EXPRESSION/
EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/
EMSG13,	TEXT /ILLEGAL EQUIVALENCING/
EMSG14,	TEXT /COMPILER MALFUNCTION/
CE,	TEXT /UNBALANCED QUOTES/
ITTAB=710
FTTAB=ITTAB+30
DOEND=2377
BSYM=6300
TSYM=7600

/ THE STATEMENT TYPE TABLE FOLLOWS
	*2600
STYPE,	7361	/-DO
	0000
	LDO
	6672	/-IF
	0000
	LIF
	7061	/-GO
	5361	/-TO
	LGOTO
	7477	/-CA
	6364	/-LL
	CAL
	5573	/-RE
	5353	/-TU
	LRET
	7461	/-CO
	6154	/-NT
	LCONT
	5454	/-ST
	6060	/-OP
	LSTOP
	5777	/-PA
	5255	/-US
	LPAUSE
	5573	/-RE
	7674	/-AD
	LREAD
	5056	/-WR
	6654	/-IT
	LWRIT
	7161	/-FO
	5563	/-RM
	LFRMAT
	7262	/-EN
	7400	/-D
	LLAST
	7461	/-CO
	6263	/-MM
	LCOMON
	7367	/-DI
	6273	/-ME
	LDIMEN
	7257	/-EQ
	5267	/-UI

	EQUI
	-0611	/-FI
	-1611	/-NI
	LFIN
XXSUBR,	5453	/-SU
	7556	/-BR
	LSUB
	7153	/-FU
	6175	/-NC
	LFUNC
	0000	/THIS IS THE END OF LIST
AREA1,	0
AREA2,	0

/ THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR
	-45	/ PREC('%') = 7    NOTE: '%' REPLACES '**'
	700
	-52	/ PREC('*') = 5
	500
	-57	/ PREC('/') = 5
	500
	-53	/ PREC('+') = 4
	400
	-55	/ PREC('-') = 4
	400
	-75	/ PREC('=') = 1
	100
	-74	/ PREC('<') = 1    NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT
	100
	1	/THIS IS THE END OF THE TABLE
THOU,	-1750
	-144
	-12
	-1

/ THE PERMANENT SYMBOL TABLE BEGINS HERE
	*6000
	1501	/MAIN
	1116
	0001
	0601	/FAD
	0400
	0001
	2324	/STO
	1700
	0001
	0623	/FSB
	0200
	0001
	0615	/FMP
	2000
	0001
	0604	/FDV
	2600
	0001
	1520	/MPY
	3100
	0001
	0411	/DIV
	2600
	0001
	2205	/READ
	0104
	0001
	2722	/WRITE
	1124
	0501
	1117	/IOH
	1000
	0001
	5060	/(0
	0000
	0001
	1215	/JMP
	2000
	0001
	1617	/NOP
	2000
	0001
	0516	/ENTRY
	2422
	3101
	0501	/EAP
	2000
	0001
	2001	/PAUSE
	2523
	0501
OPTADI,	2401	/TAD I
	0440
	1101	
OPTAD,	2401	/TAD
	0400
	0001	
OPDCA,	0403	/DCA
	0100
	0001	
OPJMPI,	1215	/JMP I
	2040
	1101
	2205	/RETRN
	2422
	1601
	0320	/CPAGE
	0107
	0501
OPSNA,	2316	/SNA
	0100
	0001
	2320	/SPC
	0300
	0001
	0301	/CALL
	1414
	0001
	0313	/CKIO
	1117
	0001
	1014	/HLT
	2400
	0001
OPCLA,	0314	/CLA
	0100
	0001
	0614	/FLOT
	1724
	0001
	1106	/IFAD
	0104
	0001
	0311	/CIA
	0100
	0001
	0310	/CHS
	2300
	0001
	0611	/FIX
	3000
	0001
	1123	/ISTO
	2417
	0001
	2001	/PAGE
	0705
	0001
BLCK,	0214	/BLOCK
	1703
	1301
	0516	/END
	0400
	0001
	1401	/LAP
	2000
	0001
	0317	/COMMN
	1515
	1601
	1123	/ISZ
	3200
	0001
	2325	/SUBSC
	0223
	0301
DUMMY,	0425	/DUMMY
	1515
	3101
	0122	/ARG
	0700
	0001
	0314	/CLEAR
	0501
	2201
	1111	/IIPOW
	2017
	2701
	0611	/FIPOW
	2017
	2701
	1106	/IFPOW
	2017
	2701
	0606	/FFPOW
	2017
	2701
	0403	/DCA I
	0140
	1101
	0103	/ACH
	1000
	0001
OPEN,	1720	/OPEN
	0516
	0001
	0522	/ERROR
	2217
	2201
	1116	/INC
	0300
	0001
FORTR,	0617	/FORTR
	2224
	2201
OPCMA,	0315	/CMA
	0100
	0001
OPIAC,	1101	/IAC
	0300
	0001
EXIT,	0530	/EXIT
	1124
	0001
	FIELD	1
	*7
L7,	0
L10,	0
L11,	0
L12,	0	/LAST LINE'S CONTENTS FOR OPTOMIZATION
	0
L14,	0
L15,	2377	/POINTER INTO DOEND LIST
L16,	0
L17,	0
L20,	0	/FLAG, NON-ZERO IF '=' SEEN
L21,	0
L22,	0	/SUBSCRIPT NESTING LEVEL
L23,	0	/USED BY "DUMARG" AND "IOHAR" PATCH
L24,	0	/LINE POINTER
L25,	0	/HIGHEST SUBSCRIPT TEMP USED
L26,	0	/USED FOR DIMENSION INFORMATION
	0	/UNUSED
L30,	0	/FOLLOWING EIGHT LOCS ARE USED BY ENTITY
L31,	0
L32,	0
L33,	0
L34,	0
L35,	0
L36,	0
L37,	0
L40,	0	/CONTAINS THE CURRENT TRIPLE NUMBER
L41,	0	/THIS IS THE POINTER INTO THE PUSH DOWN LIST
L42,	0	/THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR
L43,	0	/
L44,	0	/CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT
L45,	FTTAB	/CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED
L46,	0	/CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC
L47,	7575	/CONTAINS THREE LESS THAN START OF FCON TABLE
L50,	7600	/CONTAINS START OF DIMENSION TABLE
L51,	ITTAB	/CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED
L52,	0	/CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE
L53,	0	/CONTAINS THE LAST CREATED LABEL
L54,	0	/CONTAINS THE LABEL FOR THE CURRENT STATEMENT
L55,	-25	/CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS
L56,	6300	/CONTAINS BEGINNING OF SYMBOL TABLE
L57,	6300	/CONTAINS END OF SYMBOL TABLE
L60,	0	/"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN
L61,	0	/NON-ZERO IF LAST STMT READ IS A COMMENT
L62,	0	/NEXT FOUR LOCATIONS USED BY GENER AND ENTITY
L63,	0	/CONTAINS THE CURRENT OPERATOR
L64,	0	/POINTS TO THE LAST OPERATOR IN THE STACK
L65,	0	/CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR
BPAREN,	0	/PARENTHESIS COUNTER
L67,	0	/ONE FOR FUNCTION AND ZERO FOR SUBROUTINE
L70,	0	/CONTAINS POINTER TO SUBPROGRAM NAME
L71,	5777	/BEGINNING OF PUSHDOWN LIST
L72,	0	/SET TO ONE IF SUBSCRIPT IS ENCOUNTERED
L73,	0	/
L74,	3000	/BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS
L75,	0	/SET TO ONE SUPPRESS	/OUTPUT FROM COMPILER
L76,	0	/
L77,	0	/CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE
		/THE FOLLOWING THREE LOCS ARE USED BY THE
		/LITERAL COLLECTER
COUNT2,	0	/NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT
ESIGN,	0	/0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE
FPSW,	0	/0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT
MIKE4,MA,	3377
MIKE8,TOTAL,	0
INTA,		0
INTB,MIKE7,	0
SNUM,MB,	0
POINTZ,	3377
CHK,	0
IMPDO,	0	/"IMPLIED DO-LOOP IN PROGRESS" FLAG
KOUNT,	0
ASSIGN,	LASIGN	/ROUTINE TO PROCESS ASSIGNMENT STATEMENTS
PUTCH,	LPUTCH	/ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER
PROP,	LPROP	/PRINTS OPCODES
PRCRL,	LPRCRL	/PRINTS CREATED LABELS 
PRINT,	LPRINT	/PRINTS ONE ASCII  CHAR
P2,	LP2	/PRINT TWO PACKED ASCII CHARS
GETCH,	LGETCH	/GETS ONE CHARACTER OUT OF THE INPUT BUFFER
LUNCH,	LLUNCH	/PRINTS ERROR COMMENTS
MODE,	LMODE	/DETERMINES THE MODE OF THE ARGUMENT
LOOK,	LLOOK	/CHECKS FOR THE REST OF THE INPUT STATEMENT
ZZZ,	LZZZ	/PRINTS OUT STATEMENT LABELS
ENTITY,	LENTT	/GETS THE NEXT LOGICAL INPUT PARAMETER
SYMTAB,	LSYMTB	/ENTERS SYMBOLS INTO THE SYMBOL TABLE
DUMARG,	LDMARG	/SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT
PRSYM,	LPRSYM	/PRINTS SYMBOLS
CREATE,	LCREAT	/CREATES LABELS
PROTAC,	LPRTAC	/PRINTS CONTENTS OF AC IN OCTAL
PLAB,	LPLAB	/PRINTS LABELS
PIFF,	LPIFF	/PUTS OUT AN IFF FOR THE CONTENTS OF THE AC
TRIPL,	LTRIPL	/PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION
GENER,	LGENER	/GENERATES THE TRIPLES
LCHNG,	CHNG	/TEST FOR DUMMY ARG AND REPLACE
CLAB,	LCLAB	/HANGS A CREATED LABEL ON THE NEXT LINE
STORE,	LSTORE	/STORES THE CONTENTS OF THE AC
FPROP,	LFPROP	/PUT OUT CALLS TO F.P. ROUTINES
ZER,	LZER
DUM,	LDUM	/PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS
DIM,	LDIM	/LOOKS UP DIMENSION INFORMATION ON VARIABLES
PUNCH,	LTTYPE	/ADDRESS OF CURRENT OUTPUT ROUTINE
C2,	2
C3,	3
C40,	40
C7240,	5440	/THIS WAS COLON-SPACE NOW ITS COMMA-SPACE
C77,	77
CM40,	-40
CM4046,	-4046
CM50,	-50
CM51,	-51
CM54,	-54
CM2,	-2
CM3,	-3
CHECK,	LCHECK
SMODE,	LSMODE
BSS,	LBSS
ARG,	LARG
C54,	54
BASE,	INBUF
BASE2,	INBUF+100
C4000,	4000
GNB,	LGNB
	*177
START,	CLA		/COME HERE AT BEGINNING OF EACH STMT
	TAD	IMPDO
	SZA CLA
	JMP	ERR1	/IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON
			/CONTINUATIONS (I THINK)
	ISZ	CHK	/IS THERE A STMT IN THE BUFFER?
	JMP	.+3
	JMS I	SWAP	/YES, SWITCH BUFFER POINTERS
	JMP	.+3
	TAD	BASE
	JMS I	RCD	/NO, READ THE NEXT LINE
TEST,	TAD	L15
	TAD	CM3
	DCA	L16	/SET UP XR FOR DO TERMINATION TEST
	TAD	L54
	CIA
	TAD I	L16
	SZA CLA		/ARE WE TERMINATING A DO?
	JMP	ATRY
	JMS	LDNEXT	/TERMINATE DO LOOP
	JMP	TEST	/SEE IF THERE IS ANY MORE...
ATRY,	TAD	L61
	SZA CLA		/A COMMENT?
	JMP	CMNT
	TAD	CHK
	SZA CLA		/ILLEGAL CONTINUATION?
ERR1,	JMS I	LUNCH
	JMS I	STMT	/GET THE STMT NR...
	TAD	L32
	SNA
	JMP	.+4	/NO STMT NUMBER
	CIA
	TAD	L12
	SZA CLA		/CAN WE OMIT A TERMINAL JMP?
	JMS I	PRINT
	DCA	L24
FLST,	JMS	LIST	/PUNCH SOURCE STMT
	JMS I	WIPE	/ZERO THE SUBSCRIPT TEMP. TABLE
	TAD	L32
	DCA	L54
	TAD	CM2
	DCA	L64
	SKP
ACA,	DCA I	BAREA1
	JMS I	GETCH
	JMP	ALPH
	NOP
	JMS I	PUTCH	/PUT CHARACTER BACK
ALPH,	RTL CLL
	RTL
	RTL
	DCA	L65
	JMS I	GETCH
	JMP	ALPH2
	NOP
	JMS I	PUTCH	/PUT CHARACTER BACK
ALPH2,	TAD	L65
	ISZ	L64
	JMP	ACA
	DCA I	BAREA2
	DCA	CHK
	TAD	SSTYP	/COMPARE THESE CHARS WITH DISPATCH TABLE
	DCA	L17
TRY,	TAD I	L17
	SNA		/END OF THE TABLE?
	JMP I	ASSIGN	/YES, MUST BE ARITHMETIC STMT
	TAD I	BAREA1
	SZA CLA
	JMP	NOHIT2
	TAD I	BAREA2
	TAD I	L17
	SZA CLA 
	JMP	NOHIT1
	TAD I	L17	/FOUND A MATCH, GO TO PROPER HANDLER...
	DCA	L30
	JMP I	L30
NOHIT2,	ISZ	L17
NOHIT1,	ISZ	L17
	JMP	TRY	/DOESN'T MATCH, TRY AGAIN

LDNEXT,	0
	TAD	L15	/RESET THE DO END POINTER
	TAD	CM3
	DCA	L15
	TAD	L15
	IAC
	DCA	L16
	CMA
	TAD	L55
	DCA	L55
	JMS I	PROP	/PUNCH 'JMP <LABEL>'
	6044
	TAD I	L16
	JMS I	PRCRL
	JMS I	PRINT
	TAD I	L16	/PUNCH '<LABEL>,'
	JMS I	CLAB
	JMS I	PRINT
	JMP I	LDNEXT

PTEM,	0

LIST,	0		/PUNCH THE SOURCE STATEMENT
	TAD BASE	/GET THE POINTER
	DCA PTEM
	TAD I PTEM 	/PUNCH A CHARACTER PAIR...
	JMS I P2
	TAD I PTEM
	ISZ PTEM
	AND C77
	SZA CLA 	/END OF THE BUFFER?
	JMP LIST+3
	JMS I PRINT	/YES, PUNCH A CR-LF AND RETURN
	JMP I LIST

CMNT,	JMS I	PRINT	/WE HAVE A COMMENT
	DCA	L24
	JMS	LIST
	JMP	START


BAREA1,	AREA1
BAREA2,	AREA2
RCD,	LRCD
SSTYP,	STYPE-1		/POINTER TO STATMENT TABLE IN FIELD 1
WIPE,	LWIPE
STMT,	LSTMT
SWAP,	LSWAP
	*400
/ THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC
/ IT PUTS ONE LINE INTO THE BUFFER,
/ CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A
/ CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN
/
LRCD,	0
	DCA TEM1	/SAVE THE BUFFER POINTER
	DCA I TEM1
	DCA CHK		/ZERO CONTINUATION FLAG
	DCA L20		/ZERO THE EQUALS FLAG
	DCA L61		/ZERO THE COMMENT FLAG
	TAD CM111	/BUFFER LIMIT IS 72 CHARACTERS
	DCA IX
LRCDL,	JMS LPTRIN
	AND D177
	SNA		/LEADER OR BLANK TAPE?
	JMP LRCDL
	TAD CM177
	SNA		/RUBOUT?
	JMP LRCDL
	TAD CM15X
	SNA		/CAR RETURN?
	JMP LCAR
	IAC
	SZA		/FORM FEED?
	TAD	C2
	SNA		/LINE FEED?
	JMP LRCDL
	IAC
	SNA		/TAB?
	JMP TAB
	TAD CM75X
	SNA		/AN '=' ?
	ISZ L20
	TAD C75		/CHAR OK... RESTORE IT & PUT IN BUFFER
	JMS KRONK	/PUT IT IN THE BUFFER...
	JMP LRCDL	/AND GET ANOTHER

LCAR,	TAD IX		/PROCESS A CAR RETURN...
	CIA
	TAD CM111
	SNA CLA 	/NULL STATEMENT?
	JMP LRCDL	/YES, IGNORE
	JMS KRONK	/PUT A ZERO IN THE BUFFER
	TAD I TEM1
	TAD CM3
	SNA
	JMP	COMNT
	TAD	CM20
	SZA CLA		/TEST FOR "S" IN COLUMN ONE
	JMP	TINUE
	JMP I	(SCODE
COMNT,	ISZ L61		/SET COMMENT FLAG...
	TAD	C40
	JMP	STORSL

TINUE,	TAD TEM1	/CHECK FOR CONTINUATION...
	TAD C3
	DCA P		/SET THE POINTER TO COLS. 6 AND 7
	TAD I P
	AND C5700	/NON-ZERO OR NON BLANK IN COL 6
	TAD C4000	/MAKES THIS A CONTINUATION...
	SNA CLA 	/IS IT?
	JMP LRCDA	/MAYBE...
LRCDX,	TAD B7		/YES, MAKE IT START IN COL 7
	DCA KOUNT
	ISZ CHK		/INCREMENT THE CONTINUATION FLAG
	TAD I	TEM1
STORSL,	TAD C5700	/MAKE THIS INTO A COMMENT LINE
	DCA I TEM1
	JMP I LRCD	/THEN RETURN

LRCDA,	TAD I P 	/NUMERIC AND NON-ZERO IN COL 7 MAKES
	AND C77 	/THIS A CONTINUATION...
	TAD CM61
	SPA CLA 	/IS IT?
	JMP LRCDX+3 	/NO, RETURN
	IAC		/YES, MAKE IT START IN COL 8
	JMP LRCDX

TAB,	TAD C40 	/PROCESS TAB CHARACTERS...
	JMS KRONK	/PUT SOME SPACES IN THE BUFFER
	TAD IX
	TAD C3		/MAKE 1ST TAB GO TO COL 7
	SMA		/ARE WE AT END OF THE BUFFER?
	CLA		/YES, FORCE TERMINATION
	AND B7
	SZA CLA 	/MODULO 8?
	JMP TAB 	/NO, PUNCH SOME MORE SPACES
	JMP LRCDL	/YES, GET ANOTHER CHAR

KRONK,	0		/PUT A CHARACTER IN THE BUFFER...
	DCA CAR
	TAD IX		/FIRST COMPUTE BUFFER ADDRESS...
	TAD C112
	CLL RAR
	TAD TEM1
	DCA P
	TAD CAR 	/PICK UP THE CHARACTER
	AND C77
	SZL		/ZERO LINK SAYS WE WANT THE LEFT HALF
	JMP .+5
	RTL
	RTL
	RTL
	DCA I P
	TAD I P 	/ADD IN THE LEFT 6 BITS
	DCA I P 	/AND SALT THEM AWAY...
	ISZ IX		/BUFFER OVERFLOW?
	JMP I KRONK
	CLA CMA 	/YES, RESET THE INDEX
	DCA IX
	JMP I KRONK

LPTRIN,	0		/PAPER TAPE READER INPUT ROUTINE
	RSF
	JMP .-1
	RRB RFC
	JMP I LPTRIN

CAR,	0		/TEMPORARY, HOLDS THE CURRENT CHARACTER
P,	0		/THIS IS THE BUFFER POINTER
TEM1,	0		/THIS CONTAINS THE CURRENT BUFFER ADDRESS
IX,	0		/THIS IS THE CHARACTER COUNTER
CM111,	-111		/MINUS THE BUFFER LIMIT PLUS ONE
C112,	112		/THIS IS THE BUFFER LIMIT PLUS TWO
D177,	177
CM177,	-177
CM15X,	177-15
CM75X,	11-75
C75,	75
B7,	7
C5700,	5700
CM61,	-61
CM20,	-20
M1700,	-1700
	*600
CAL,	TAD	KOUNT	/SUBROUTINE CALL STMT PROCESSOR
	DCA	COUNT3
	JMS I	ENTITY
	JMP I	ASSIGN
	JMP	ON
COUNT3,	0
Q12,	12
	JMP I	ASSIGN
ON,	JMS I	GNB
	SNA		/ANY ARGUMENTS?
	JMP	CR2	/NO
	TAD	CM50
	SZA		/MAYBE, IS THIS A '(' ?
	JMP I	ASSIGN
	JMS I	ZZZ	/YES, PUNCH STMT NR, IF ANY
	TAD	COUNT3
	DCA	KOUNT
	ISZ	L44
	DCA	L46	/AC SWITCH
	DCA	L52	/IF STATEMENT SWITCH
	JMS I	GENER	/LET TRIPLE GENERATOR PROCESS IT
	DCA	L46	/ZERO AC AGAIN
	JMP	START	/COMPLETE, GET NEXT STATEMENT
CR2,	ISZ	L32	/NO ARGUMENTS
	JMS I	SYMTAB
	TAD	L77
	DCA	GLU
	JMS I	ZZZ	/PUNCH '<LABEL>, CALL 0,<NAME>'
	JMS I	FPROP
GLU,	0
	JMP	START
LGNB,	0
	JMS	LGTC
	DCA	GLU
	TAD	GLU
	TAD	CM40
	SNA CLA
	JMP	LGNB+1
	TAD	GLU
	JMP I	LGNB
LGETCH,	0
	JMS I	GNB
	SNA		/IS IT A END OF CARD
	JMP	PUNC	/YES ITS PUNTUATION
	TAD	QM32
	SPA SNA		/IS IT ALPHABETIC
	JMP	ALPHA		//YES
	TAD	CM40
	CLL
	TAD	Q12
	SZL		/IS IT NUMERIC?
	ISZ	LGETCH	/NUMERIC
PUNC,	ISZ	LGETCH	/PUNCTUATION
ALPHA,	CLA		/ALPHABETIC
	TAD	GLU
	JMP I	LGETCH	/RETURN
/	THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER
/	ROUTINE SKIPS IF SYMBOL IS INTEGER
LMODE,	0
	SMA		/IF ITS PLUS WE HAVE AN INTEGER
	JMP	AINT	/WE HAVE AN INTEGER
	RAL		/GET NEXT BIT
	SPA		/CHECK THIS BIT
	JMP	FV	/ITS EITHER A FCON OR VARIABLE
	RTL		/GET NEXT TWO BITS
	SNL		/IS IT AN OPERATOR
ERR2,	JMS I	LUNCH	/YES
AFP,	SMA CLA 	/CHECK THIS BIT
	JMP	AINT	/ITS AN INTEGER
	JMP I	LMODE	/SYMBOL WAS F P MODE
FV,	RAR		/RESTORE AC TO ORIGINAL CONTENTS
	CIA		/SET NEGATIVE
	TAD	L47	/ADD START OF FCON TABLE
	SPA		/IS	/SYMBOL FCON
	JMP	AFP	/YES
	CIA		/NO	/RESTORE AC AGAIN
	TAD	L47
	DCA	ATEM	/SAVE THE RESTORED NUMBER
	TAD I	ATEM	/GET THE POINTER TO THE VARIABLE
	TAD	CM1100	/SUBTRACT AN I
	SPA		/IS IT LESS THAN I
	JMP	AFP	/YES	ITS FLOATING POINT
	TAD	CON1	/NOW SUBTRACT AN N
	SPA CLA 	/IS IT LESS THAN N
AINT,	ISZ	LMODE	/YES
CON1,	CLA		/CLEAR THE AC FOR THE RETURN
	JMP I	LMODE
ATEM,	0
CM1100,	-1100
QM32,	-32
LGTC,	0		/GET A CHARACTER FROM THE BUFFER
	TAD	KOUNT
	ISZ	KOUNT
	CLL RAR		/LINK TELLS IF LEFT OR RIGHT HALF
	TAD	BASE
	DCA	GLU
	TAD I	GLU
	SZL		/WHICH CHARACTER
	JMP	MMSK
	RTR
	RTR
	RTR
MMSK,	AND	C77
	SZA
	JMP I	LGTC
	TAD	CHK
	SPA CLA		/DO WE WANT A NEW LINE YET?
	JMP I	LGTC	/NOT YET...
	TAD	BASE2	/YES, USE THE ALTERNATE BUFFER
	JMS I	RLCD
	TAD	CHK
	SZA CLA		/IS IT A CONTINUATION?
	JMP	.+4
	CMA		/NO, SET FLAG AND RETURN W ZERO AC
	DCA	CHK
	JMP I	LGTC
	JMS	LSWAP	/YES, SWITCH BUFFERS AND CONTINUE
	DCA	CHK
	JMP	LGTC+1

RLCD,	LRCD
LSWAP,	0		/SWITCH THE LINE BUFFER POINTERS
	TAD	BASE
	DCA	ATEM
	TAD	BASE2
	DCA	BASE
	TAD	ATEM
	DCA	BASE2
	JMP I	LSWAP
	*1000
/ 	THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS
/	IN LOC 41,  THE CURRENT TRIPLE NUMBER IS IN LOCATION 40
/	LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT.
PBEGN,	AREA2		/START OF THE PRECEDENCE LIST
BINTEG,	TAD	L32	/HERE IF ENTITY SENT AN INTEGER
	JMP I	BPUSH	/PUSH IT INTO STACK
FLPT,	JMS I	FCON	/HERE IF ENTITY FOUND A FLOATING POINT CON
	SKP		/ENTER IT INTO FPTABLE
BLPHA,	JMS I	SYMTAB	/HERE IF ENTITY FOUND A VARIABLE
	TAD	L77	/PICK UP POINTER INTO SYM TAB OR FLPT TAB AN
	JMP I	BPUSH	/PUSH IT DOWN
LABELX, JMP I	LGENER
LGENER,	0		/ENTRY POINT
	TAD	C5000
	DCA	L40	/*
	DCA	L21	/ZERO THE SYMBOL TABLE SWITCH
	TAD	L71
	DCA	L41	/SET PUSH DOWN POINTER
	DCA	L22
	DCA	BPAREN	/ZERO OUT THE PAREN SWITCH
	TAD	C4000
	DCA I	L41	/FIRST PUSH DOWN LEFT CLOSURE NAMELY 0
BNEXT,	JMS I	ENTITY	/THIS WILL GET THE NEXT DATUM TO BE PROCESSE
	JMP	HOO	/END OF STATEMENT RETURN,TREAT LIKE PUNCTION
	JMP	BLPHA	/VARIABLE RETURN
	JMP	BINTEG	/INTEGER RETURN
	JMP	FLPT	/FLOATING POINT RETURN
HOO,	TAD	CM50	/PUNCTIOATION RETURN,
	SNA		/IS IT (
	JMP I	BPAR	/YES
	TAD	C7753
	SZA		/IS IT AN '=' ?
	JMP	BRET
	TAD	L44	/WE HAVE AN '=',  IS IT LEGAL?
	SNA CLA
	JMP	BRET	/IT IS
	TAD	IMPDO
	SZA CLA		/ARE WE IN AN IMPLIED DO LOOP?
	JMP I	PIOEQL	/YES - TERMINATE LOOP CODE
ERR3,	JMS I	LUNCH
PIOEQL,	IOEQL
BRET,	TAD	C0075
	DCA	L63
	TAD I	L41	/CHECK FOR A UNARY OPERATOR
	TAD	C4000
	AND	C7000
	SZA CLA 	/WAS IT AN OPERAATOR AT ALL
	JMP	PREC	/NO, STILL NOT UNARY OPERATOR
	TAD	L63
	TAD	C7725
	SNA		/IS IT A '+'  
	JMP	BNEXT	/YES, IGNORE IT
	TAD	CM2	/NO
	SZA CLA		/IS IT A '-' ?
	JMP	ERR3
	TAD	C4643	/THIS IS THE UNARY MINUS
	JMP I	BPUSH
PREC,	TAD	PBEGN	/HERE IS WHERE WE FIND THE PRECIDENCE
	DCA	L17
	DCA	L65
	SKP
RETUR,	ISZ	L17	/PICK UP NEXT OP CODE IN LIST
	TAD I	L17	/TO GET THE NEXT LIST ITEM
	SMA SZA 	/IS THIS THE END OF THE LIST
	JMP	BMORE	/NO, THE ASSUMPTION IS THAT THE PRECIDENCE
	TAD	L63	/IS ZERO
	SZA CLA 	/IS THIS THE RIGHT TABLE ENTRY
	JMP	RETUR	/TRY AGAIN	(IT WASN"T)
	TAD I	L17	/TO GET THE PRECEDENCE
	DCA	L65
BMORE,	CLA IAC 	/HERE WE ARE GOING TO SEE IF THERE IS A PREC
	TAD	L41
	DCA	L64	/L64 NOW POINTS TO THE PREVIOUS OPERATOR
	TAD I	L64
	TAD	C4000
	AND	C7000
	SZA		/IS THERE A VALID OPERATOR ON THE STACK?
	JMP	ERR3	/APPARENTLY NOT...
	TAD I	L64	/IF THE PRECEDENCE OF THE PREVIOUS OPERATOR
	AND	C700	/IS NON-ZERO, AND ITS PRECEDENCE IS GREATER
	SNA		/THAN OR EQUAL TO THE PRECEDENCE OF THE
	JMP	NO	/CURRENT OPERATOR, THEN PROCESS THE PREVIOUS
	CIA		/OPERATOR; IF NOT WE WILL PROBABLY PUT
	TAD	L65	/THE CURRENT OPERATOR ON THE STACK AND GET
	SMA SZA CLA	/ANOTHER ITEM FROM THE STATEMENT BUFFER...
	JMP	NO
	ISZ	L40	/YES, INCREMENT THE TRIPLE NUMBER AND....
	JMS I	TRIPL	/PROCESS THE PREVIOUS OPERATOR
	ISZ	L41	/*****NOTE	WHAT IF IT WAS UNARY************
	TAD I	L41
	TAD	C3135	/THIS IS MINUS UNARY MINUS
	SZA CLA
	ISZ	L41	/DELETE THE LAST 3 ITEMS AND REPLACE WITH TR
	TAD	L46
	DCA I	L41
	JMP	BMORE	/TRY FOR ANOTHER TRIPLE
NO,	TAD	L63
	SNA		/IS IT A END OF STATEMENT MARK
	JMP I	LCDONE	/IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING
	TAD	CM51
	SNA		/IS IT A ')' ?
	JMP I	LKPAR	/YES
	TAD	CM3
	SZA		/IS IT A ',' ?
	JMP	NCOMMA	/NO
	TAD	BPAREN
	SNA CLA		/IS A COMMA LEGAL HERE?
	JMP I	LCDONE	/MAYBE...
NCOMMA,	TAD	CM21
	SNA CLA		/IS IT AN EQUALS SIGN?
	ISZ	L44	/YES - SET EQUALS SWITCH ON
	TAD	L63	/PUT THE OPERATOR ON THE STACK
	TAD	L65	/ADD THE PRECEDENCE
	TAD	C4000
	JMP I	BPUSH
/
BPUSH,	PUSH
C5000,	5000
BPAR,	ALPAR
C7753,	7753
C0075,	75
C7000,	7000
CM21,	-21
C7725,	7725
C4643,	4643
C700,	700
C3135,	3135
LCDONE,	CDONE
LKPAR,	KPAR
FCON,	LFCON
	*1200
PUSH,	DCA	L63
	CLA CMA
	TAD	L41	/SPACE THE POINTER UP ONE
	DCA	L41	/*
	TAD	L63
	DCA I	L41	/*
	JMP I	LBNEXT	/BACK TO BEGINING
/	THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS---
/ IF ARITHMETIC, JUST DELETE BOTH ( AND )
KPAR,	TAD I	L64
	TAD	C3730	/MINUS LEFT PAREN
	SZA		/IS IT (
	JMP	BCON	/NO-- CHECK SOME MORE
	TAD I	L41	/DELETE PARENS
	DCA I	L64
	ISZ	L41	/UPDATE POINTER
LAPP,	ISZ	BPAREN	/DO PARENS BALENCE
	JMP I	LBNEXT
	TAD	L52	/YES
	SNA CLA 	/SHOULD WE RETURN IF BALANCED
	JMP I	LBNEXT
	TAD	L46
	SZA CLA
	JMP	CDONE
	TAD I	L41
	DCA	L77
	JMS I	XTAD	/GENERATE TAD OR (TAD I)
	DCA I	L41	/ZERO IS INTEGER
CDONE,	TAD	L41
	CMA
	TAD	L71
	SZA		/WELL...
ERR6,	JMS I	LUNCH	/HA...YOU GOOFED
	JMS I	XZQ
	JMP I	.+1
	LABELX
BCON,	IAC		/IS IT FUNCTION
	ISZ	L40
	SNA
	JMP	BFOUT	/YES
	IAC		/NO-- NOW IS IT SUBSCRIPT
	SNA	
	JMP	SOUT	/YES
	TAD	C7772	/NO
	SZA		/IS IT COMMA
	JMP	ERR6	/NO - BYE BYE CHARLIE
	ISZ	L64
	ISZ	L64
	TAD I	L64
	TAD	C3724	/IS IT A COMMA
	SNA
	JMP	BFOUT	/FOUND TWO COMMAS,MUST BE FUNCTION
	TAD	C5	/NO
	SNA		/IS IT A PRIME
	JMP	BFOUT	/GOT A FUNCTION
	IAC		/NO
	SZA CLA
	JMP	ERR6	/SORRY, IT AIN'T NUTTIN
SOUT,	JMS I	PLSBSC		/PROCESS A SUBSCRIPT
	CMA
	TAD	L22
	DCA	L22
	SKP
BFOUT,	JMS I	FUNCT
	JMP	LAPP
FUNCT,	LFUNCT
/ THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR
ALPAR,	CMA
	TAD	BPAREN
	DCA	BPAREN
	TAD I	L41
	TAD	C4000
	AND	B7000	/IS IT AN OPERAND
	SZA CLA 
	JMP	CUNT	/NO	, TRY SOME MORE
	IAC
	JMP	PRIME
CUNT,	TAD I	L41	/PICK UP TOP LIST ITEM
	TAD	C2	/ADD TWO TO FIND THE DIMENSION INTO(INFO)
	DCA	L64
	TAD I	L64
	AND	C20	/JUST WANT ONLY THIS ONE BIT(DIMENSION)
	SNA CLA  	/IS IT DIMENSIONED
	JMP	PRIME	/NO	ITS GOT TO BE A FUNCTION CALL
	ISZ	L22
	CMA
PRIME,	TAD	C4047
	JMP	PUSH	/GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN
XZQ,	LXZQ
LBNEXT,	BNEXT
C3730,	3730
C7772,	7772
C3724,	3724
C5,	5
D7,	7
B7000,	7000
C20,	20
C4047,	4047
XTAD,	LXTAD
LPUTCH,	0
	CLA CMA
	TAD	KOUNT
	DCA	KOUNT
	JMP I	LPUTCH

LASIGN,	TAD	L20	/ARITHMETIC STATEMENT PROCESSOR
	SNA CLA		/IS THERE AN '=' IN THE STMT?
ERR9,	JMS I	LUNCH	/NO, BETTER COMPLAIN...
	TAD	D7	/SET POINTER TO COL 7
	DCA	KOUNT
	JMS I	ZZZ	/PUNCH THE LABEL, IF ANY
	DCA	L46
	DCA	L44
	DCA	L52
	JMS I	GENER	/PROCESS IT...
	TAD	L63
	SZA CLA		/WAS TERMINATOR A <CR/LF> ?
	JMP	ERR9	/NO, ILLEGAL STATEMENT ERROR ...
	JMP	START
PLSBSC,	LSUBSC

LPRCRL,	0		/SUBROUTINE PRINTS CREATED LABELS
	DCA LPRCTM
	TAD C36		/PUNCH '^'
	JMS I PRINT
	TAD LPRCTM	/PUNCH THE LETTERS
	JMS I P2
	JMP I LPRCRL
C36,	36
LPRCTM,	0
	*1400
PRET,	ISZ	LENTT	/PUNCTIONATION EXIT POINT
FRET,	ISZ	LENTT	/FLOATING POINT EXIT POINT
XIRET,	ISZ	LENTT	/INTEGER EXIT POINT
XARET,	ISZ	LENTT	/VARIABLE EXIT
ERET,	JMP I	LENTT	/CR END OF LINE EXIT
LENTT,	0		/ENTRY POINT
	CLA		/WIPE OUT PSEUDO ACCUMULATOR
	DCA	L32
	DCA	L31
	DCA	COUNT2	/RESET ALL KINDS OF THINGS TO ZERO
	DCA	L36
	DCA	L37
	DCA	L30
	DCA	FPSW
	DCA	ESIGN
	TAD	CM6
	DCA	L65	/SET UP FOR MAXIMUM OF 6 CHARS
	JMS I	GETCH	/GET THE FIRST INPUT CHARACTER
	JMP	.+3	/ALPHA RETURN
	JMP	PUNCT	/PUNCTIONATION RETURN
	JMP	DIG	/DIGIT RETURN
	JMS	PACK	/STORE THIS CHARACTER
	JMS I	GETCH	/GET ANOTHER CHACTER
	JMP	.-2	/ALPHA- IS OK
	SKP		/PUNCTUATION
	JMP	.-4	/DIGIT--IS OK PROCESS IT
	JMS I	PUTCH	/PUT THAT PUNCTUATION BACK IN THE BUFFER
	TAD	L32
	AND	CC7700	/MAKE SURE NAME IS <= 5 CHARACTERS LONG
	DCA	L32
	JMP	XARET	/RETURN WITH VARIABLE

PACK,	0		/THIS PACK CHARS INTO L30 L31 AND L32
	DCA	L64	/SAVE THE CHAR...
	TAD	L65
	SNA		/DO WE HAVE SIX CHARS ALREADY?
	JMP I	PACK	/YES - IGNORE
	STL; RAR
	TAD	P33
	DCA	LTEM
	ISZ	L65
C7,	7
	TAD	L64
	CDF 10
	SNL		/DO WE HAVE LEFT OR RIGHT HALF?
	JMP	.+5
	CLL RTL		/MUST BE LEFT HALF...
	RTL
	RTL
	SKP
	TAD I	LTEM
	DCA I	LTEM
	CDF 00
	JMP I	PACK
LTEM,	0

PUNCT,	SNA		/HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET
	JMP	ERET	/YES,	GO RIGHT BACKTO THE CALLER....BY-BY
	TAD	C7722	/IS IT A PERIOD
	SNA
	JMP	CC	/YES--WE ASSUME THAT THIS LENTT IS A FLOATING
	TAD	C7
	SNA		/IS IT A QUOTE?
	JMP I	QUOTE	/YES - CHARACTER LITERAL
	TAD	CM3
	SZA		/IS IT AN ASTERISK
	JMP	NAH	/NO
	JMS I	GETCH	/YES- PEEK AT NEXT CHAR
	JMP	NOASS	/ALPHA-- PUT IT BACK
	JMP	ASSCK	/PUNCTUATION-- CHECK FOR AN ASTERISK
NOASS,	JMS I	PUTCH	/DIGIT---PUT IT BACK
NAH,	TAD	X52	/RESTORE CHARACTER TO WHAT IT WAS
	JMP	PRET	/THATS ALL---IT WAS PUNCTIONATION
ASSCK,	TAD	CM52	/ANOTHER PUNCTUATION--IS IT (*)
	SZA
	JMP	NOASS	/NO---PUT IT BACK
	TAD	C45	/IT WAS-- CHANGE ** TO PERCENT
	JMP	PRET	/---ALTERED PUNCTUATION
DIG,	AND	C17	/FIRST CHAR WAS A DIGIT,	DONT KNOW IS INTEGER O
	DCA	L32	/AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER
CA,	JMS I	GETCH	/GET ANOTHER CHACTER
	JMP I	LTESTE	/ALPHA--GO SEE IF IT IS AN -E-
	SKP		/PUNCT
	JMP	BONT	/DIGIT GO PROCESS IT
	TAD	C7722	/PUNCTUATION HERE,	IS IT A PERIOD
	SZA
	JMP I	LCOP	/ IT IS . WE HAVE A FLOATING POINT NUMBER
CC,	TAD	FPSW
	SZA
ERR10,	JMS I	LUNCH	/TOO MANY (.)
	ISZ	FPSW
	DCA	COUNT2
	JMP	CA	/GO BACK AND GET ANOTHER CHAR
BONT,	AND	C17	/***COME HERE WITH ANOTHER DIGIT.
	DCA	L36	/SAVE IT
	ISZ	COUNT2
	JMS I	LMUL10	/ AC = AC * 10 + DIGIT
	JMP	CA	/GO GET ANOTHER CHAR
P33,	L30+3
CM6,	-6
C7722,	7722
X52,	52
CM52,	-52
C17,	17
LTESTE,	TESTE
C45,	45
LCOP,	COP
LMUL10,	MUL10
QUOTE,	LQUOTE


DMPLIN,	0		/SUBROUTINE TO DUMP "LAST LINE" BUFFER
	ISZ	L24
	TAD I	L24	/GET NEXT CHAR
	JMS I	PUNCH	/PUNCH IT
	TAD I	L24
	TAD	CM212
	SZA CLA		/IS CHAR A LINE FEED?
	JMP	DMPLIN+1	/NO
	CLA IAC
	DCA	L24	/RESET POINTER
	DCA	L12	/ZERO CONTENTS FLAG
	JMP I	DMPLIN	/RETURN
CM212,	-212
CC7700,	7700
	*1600
TESTE,	TAD	C7773	/IS IT E
	SZA
	JMP	COP	/NO, GO PUT IT BACK AND PROCESS
/	HERE IF EXPONENT FOLLOWES
	DCA	L37	/IT WAS AN E
/ THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE
/
	ISZ	FPSW	/MAKE SURE THE FLOATING POINT SWITCH WAS KICKED
	JMS I	GETCH	/GET ANOTHER CHAR
	JMP	ERR12	/ALPHA	, CANT BE-- SO LONG, ITS BEEN NICE
	SKP		/PUNCT
	JMP	CD	/DIGIT, GO PROCESS IT
	TAD	X7725	/IS IT PULS SIGN
	SNA
	JMP	CF	/YES, IGNOR IT
	TAD	CM2
	SZA		/IS IT MINUS
	JMP	COP	/NO, GO PROCESS THE FLOATING POINT NUMBER
	CLA CMA
	DCA	ESIGN	/YES- REMEMBER THAT THE EXPONENT WAS MINUS
CF,	JMS I	GETCH	/GET ANOTHER CHAR
	JMP	COP	/ALPHA, ALL READY TO PROCESS
	JMP	COP	/PUNCTUATION, READY TO PROCESS
CD,	AND	X17	/DIGIT
	DCA	L36	/SAVE IT IN 36 AND..
	TAD	L37	/MULTIPLY THE - EXPONENT TO DATE- BY 10
	RAL CLL
	DCA	L37
	TAD	L37
	RAL CLL
	RAL CLL
	TAD	L37
	TAD	L36	/AND ADD IN THIS DIGIT I.E. 37C10*
	DCA	L37	/ L37 = 10 * L37 + L36
	JMP	CF	/GO DO IT AGAIN
COP,	JMS I	PUTCH
	CLA CLL 	/PROCESS THIS NUMBER
	TAD	FPSW	/IS IT AN INTEGER
	SZA CLA
	JMP	CH	/NO, MUST BE FLOATING POINT
/	INTEGER IS IN ACC
	TAD	L30	/YESS
	SNA		/MAKE SURE INTEGER IS VALID
	TAD	L31
	SZA CLA
	JMP	ERR12
	TAD	L32
	SPA CLA
ERR12,	JMS I    LUNCH   /TOO BIG
	JMP I	.+1	/TAKE INTEGER RETURN WITH INTEGER IN 32
	XIRET
CH,	TAD	L37	/WAS THIS AN E-CONVERSION NUMBER
	ISZ	ESIGN	/EXPONENT POSITIVE?
	CIA		/YES
	TAD	COUNT2	/ADD POST-DECIMAL COUNTER
	CLL
	SNA
	JMP	CM	/NOTHING TO DO
	SMA		/DETERMINE WHETHER TO
	CML CIA		/MULTIPLY OR DIVIDE
	DCA	COUNT2
	RAL
	TAD	CJ
	DCA	CK
	JMS	XFLOAT	/SET UP THE NUMBER
CK,	HLT		/JMP I (MULT OR JMP I (DIVIDE
	ISZ	COUNT2
	JMP	CK	/LOOP ON COUNT
	JMP I	LPOLIS	/FINISH UP

CM,	JMS	XFLOAT
	JMP I	LPOLIS
CJ,	JMS I	.+1
	MULT
	DIVIDE

/ THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT
XFLOAT,	0
	CLA CLL
	TAD	L32	/CHECK IF THE ACCUMULATED NUMBER IS ZERO
	SNA
	TAD	L31
	SNA
	TAD	L30
	SNA CLA
	JMP I	LFRET	/IT WAS ZERO SEND A FLOATING POINT ZERO BACK--
	TAD	C2440	/IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10
	DCA	L37
	JMS	NORMAL	/GO TO THE NORMALIZE ROUTINE
	JMP I	XFLOAT	/AT THIS POINT THE MANTISA AND EXPON ARE SEPERA
/	ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U
/	NORMAL IZATION OF A F P NUMBER
NORMAL, 0
DA,	TAD	L30	/WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N
	SPA CLA
	JMP I	NORMAL	/IT IS NEG.,	ALL DONE
	JMS I	LLSHIF	/GO DO A TRIPLE PRECISION LEFT SHIFT
	TAD	L37	/AND SUBTRACT ONE FROM THE EXPONENT
	TAD	C7770	/NOTE-- THE 3 LOW ORDER BITS ARE NOT USED
	SPA		/IF THIS DOESNT SKIP WE HAVE F P OVERFLOW
	JMP	ERR12	/BY-BY	NUMBER TOO LARGE FOR THE MACHINE
	DCA	L37
	JMP	DA
/ THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ
C7773,	7773
X7725,	7725
X17,	17
C7770,	7770
LPOLIS,	POLISH
LFRET,	FRET
C2440,	2440
LLSHIF,	LSHIFT

SCODE,	CDF 10		/SHIFT S-CODE 2 COLS. LEFT
	TAD I	(TEM1
	CDF 0
	DCA	SLOC1
	TAD	SLOC1
	IAC
	DCA	SLOC2
	ISZ	L61	/SET COMMENT FLAG
SCODL,	TAD I	SLOC2
	DCA I	SLOC1
	TAD I	SLOC2
	AND	C77
	SNA CLA		/END OF LINE?
	JMP I	(STORSL+2
	ISZ	SLOC1
	ISZ	SLOC2
	JMP	SCODL	/AND CONTINUE PROCESS

SLOC1,	0
SLOC2,	0
	*2000
XSAVE,	0		/-- THE F.P. AC IS IN LOCS 30-32
	TAD	L30	/-- THE "MQ" IS IN LOCS 33-35
	DCA	L33	/---THE EXPONENT IS IN LOCS 37
	TAD	L31
	DCA	L34
	TAD	L32
	DCA	L35
	JMP I	XSAVE
/ SHIFTS THE PSEUDO-ACC LEFT ONE PLACE
LSHIFT, 0
	CLA CLL
	TAD	L32
	RAL
	DCA	L32
	TAD	L31
	RAL
	DCA	L31
	TAD	L30
	RAL
	DCA	L30
	JMP I	LSHIFT
/ THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC
ADD,	0
	CLA CLL
	TAD	L32
	TAD	L35
	DCA	L32
	RAL
	TAD	L31
	TAD	L34
	DCA	L31
	RAL
	TAD	L30
	TAD	L33
	DCA	L30
	JMP I	ADD
/ THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE
RSHIFT, 0
	CLA CLL
	TAD	L30
	RAR
	DCA	L30
	TAD	L31
	RAR
	DCA	L31
	TAD	L32
	RAR
	DCA	L32
	JMP I	RSHIFT
/
/
MULT,	0		/ACCCACC*10 MQ
	JMS	RSHIFT
	JMS	XSAVE
	JMS	RSHIFT
	JMS	RSHIFT
	JMS	ADD	/THIS FINISHES THE MULT BY 10
	TAD	L37	/NOW DIDDLE THE EXPONENT
	TAD	C40
	SPA		/OVERFLOW TEST
ERR14,	JMS I	LUNCH	/FLOATING POINT OVERFLOW
	DCA	L37
	JMS I	LNRMAL	/MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO
	JMP I	MULT
DIVIDE, 0		/DIVIDE THE F P NUMBER BY 10
	JMS	RSHIFT	/BASED ON THE FACT THAT .1 BASE 10 C .000110011
	JMS	XSAVE	/THAT IS WE MULTIPLE BY ONE TENTH
	TAD	C7766	/THIS IS A COUNTER**********************
	DCA	ZCTR
DB,	JMS	RSHIFT
	JMS	ADD
	ISZ	ZCTR
	SKP
	JMP	DC
	JMS	RSHIFT
	JMS	RSHIFT
	JMS	RSHIFT
	JMS	ADD
	JMP	DB
DC,	TAD	L37
	TAD	C7750	/********INSERT HERE THE CONSTANT************
	DCA	L37	/WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP 
	JMS I	LNRMAL	/MAKE SURE IT IS STILL NORMALIZ D
	JMP I	DIVIDE
ZCTR,	0
MUL10,	0		/THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E
	JMS	LSHIFT	/BY 10
	JMS	XSAVE
	JMS	LSHIFT
	JMS	LSHIFT
	JMS	ADD
	TAD	L36	/NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH
	DCA	L35	/*
	DCA	L34
	DCA	L33
	JMS	ADD	/AND ADD IT TO THE ACC
	JMP I	MUL10	/IN OTHER WORDS	ACCCACC*10 DIGIT
POLISH, CLA CLL 	/THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT.
	TAD	C400	/AND PUTS THEM INTO 7090 FORM.	THIS IS THE R-U
	DCA	L35	/27 DIGITS
	DCA	L34	/ROUND FACTOR IS CRAMED INTO THE MQ
	DCA	L33
	JMS	ADD	/AND ADDED TO THE INTEGER IN THE ACC
	SNL		/IF THE LINK IS ON, WE OVERFLEW ON THE CARRY
	JMP	POLSH	/WE DIDNT
	TAD	C4000	/SET THE ACC TO .1000000000	(THE REST OF IT IS
	DCA	L30
	TAD	L37	/DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N
	TAD	J10
	SNA
	JMP	ERR14	/EXPONENT OVERFLOW ...
	DCA	L37
POLSH,	TAD	C7767	/NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES
	DCA	ZCTR	/( THATS SO WE WILL HAVE ROOM TO STICK IN THE E
HOOP,	JMS	RSHIFT
	ISZ	ZCTR
	JMP	HOOP
	TAD	L37	/CRAM THE EXP
	TAD	L30	/INTO THE ACC
	DCA	L30	/AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX
	JMP I	.+1
	FRET
LNRMAL,	NORMAL
C7766,	7766
C7750,	7750
C400,	400
J10,	10
C7767,	7767
	*2200
/	THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER
LSTMT,	0
	JMS I	CLEAR	/CLEAR THE PSEUDO ACC AND MQ
	TAD	C4000	/DON'T LET LGTC GET ANOTHER LINE YET
	DCA	CHK
	IAC
	DCA	KOUNT
LABEL,	JMS I	GTCL	/GET A CHARACTER
	SNA		/IS THIS A CAR RET?
ERR15,	JMS I	LUNCH	/YES, INCOMPLETE STATEMENT
	TAD	CM40
	SNA		/SPACE?
	JMP	SPACE
	TAD	CM32
	CLL
	TAD	C12
	SNL		/ 260 <= CHAR < 272 ?
ERR16,	JMS I	LUNCH
	DCA	L36	/SAVE THIS DIGIT...
	JMS I	MULT10	/ ACC = 10 * ACC + L36
SPACE,	TAD	KOUNT
	TAD	DM6
	SPA CLA		/END OF STMT NR FIELD?
	JMP	LABEL	/NOT YET...
	JMS I	GTCL	/SKIP OVER COL 6
	SNA CLA		/IS IT A CAR RET?
	JMP	ERR15
	TAD	L31	/SEE IF STMT NR IS LEGAL...
	SZA
	JMP	ERR16
	TAD	L32
	SPA CLA		/IS STMT NR < 2048 ?
	JMP	ERR16	/NO, STMT NR TOO BIG
	JMP I	LSTMT
CLEAR,	LCLEAR
GTCL,	LGTC
MULT10,	MUL10
CM32,	-32
DM6,	-6
C12,	12
/
/	SUBROUTINEE TO PRINT A SYMBOL
/
/	JMS I	PRSYM
/
LPRSYM,	0		/THIS ROUTINE PRINTS SYMBOLS
	DCA	LCH
	TAD	LCH
	SMA		/IS IT AN INTEGER CONSTANT
	JMP	ICON	/YES PROCESS IT
	RTL		/SHIFT THE NEXT BIT INTO THE LINK
	SNL		/IS IT A TEMPORARY
	JMP	TEMPO	/ITS A TEMPORARY
	RTR		/RESTORE THE SYMBOL
	CIA		/SET IT NEGATIVE
	TAD	L47	/SUBTRACT THE BEGINNING OF THE XFCON TABLE
	SPA CLA 	/DO WE HAVE AN FCON
	JMP	XFCON	/YES PROCESS IT
	TAD	LCH
	TAD	C2	/ADD TWO TO THE SYMBOL TABLE POINTER
	DCA	LP2	/AND SAVE IT
	TAD I	LP2	/GET THE CONTROL BITS FOR THE SYMBOL
	RAR		/GET EXTERNAL SUBROUTINE BIT IN LINK
	SZL CLA 	/IS THIS AN EXTERNAL SUBROUTINE
	JMP	SKPIT	/YES...DONT PUT OUT THE BACK SLASH
	TAD	C34
	JMS I	PRINT
SKPIT,	TAD I	LCH
	JMS	LP2	/PRINT THEM
	ISZ	LCH
	TAD I	LCH
	JMS	LP2	/AND PRINT THEM
	ISZ	LCH
	TAD I	LCH
	AND	X7700	/MASK SO WE DONT PUT OUT CONTROL BITS
	JMS	LP2	/AND PRINT IT
	JMP I	LPRSYM	/NOW RETURN
LP2,	0		/THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS
	DCA	UNCH	/SAVE THE CHARS
	TAD	UNCH	/GET THEM AGAIN
	RTR		/ROTAT FIRST CHAR INTO POSITION
	RTR
	RTR
	AND	C77	/MASK SECOND CHARACTER
	SZA		/IS IT AN ACTUAL CHARACTER
	JMS I	PRINT	/YES PRINT IT
	TAD	UNCH	/GET THE TWO CHARS AGAIN
	AND	C77	/MASK OUT FIRST CHARACTER
	SZA		/IS IT ACTUALLY A CHARACTER
	JMS I	PRINT	/YES PRINT IT
	JMP I	LP2	/AND RETURN
ICON,	CLA		/INTEGER CONSTANT, PUNCH A '('
	TAD	K50
	JMS I	PRINT
	TAD	LCH	/AND THE NUMBER
PROCT,	JMS I	PROTAC
	JMP I	LPRSYM	/RETURN
TEMPO,	RTL
	SPA CLA		/SUBSCRIPT TEMPORARY?
	JMP	SBSCR
	RTL
	TAD	D33	/PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT
	JMS I	PRINT	/AND PRINT IT
	TAD	LCH
	SPA		/DO WE STILL HAVE A TEMPORARY
	JMS I	TEMPOR	/YES GET THE TEMPORARY NUMBER
	JMS I	PRINT	/AND PRINT IT
	JMP I	LPRSYM	/RETURN
SBSCR,	TAD	D33	/SUBSCRIPT TEMPORARY, PUNCH A '['
	JMS I	PRINT
	TAD	LCH
	JMS I	SUBTEM	/AND 4 DIGITS
	JMP	PROCT
XFCON,	TAD	C35	/FLOATING POINT CONSTANT...
	JMS I	PRINT	/PUNCH A ']'
	TAD	LCH
	CIA
	TAD	L50	/SUBTRACT FROM END OF TABLE
	JMP	PROCT
D33,	33
C35,	35
K50,	50
C34,	34
X7700,	7700
LCH,	0
UNCH,	0
SUBTEM,	LSBTEM
TEMPOR,	LTMPOR
	*2400
/
/	SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS
/
C300,	300
C212,	212
C215,	215
SCOUNT, 0		/CURRENT NUMBER OF SYMBOLS
XCTR,	0		/COUNTER
FCOUNT, 0		/CURRENT NUMBER OF FCONS
LSYMTB, 0
	CLA		/CLEAR THE AC
LOOP1,	TAD	L56	/GET BEGINNING OF SYMBOL TABLE
	DCA	LSYMTM	/AND SAVE IN TABLE
	TAD	SCOUNT	/GET NUMBER OF SYMBOLS CURRENTLY
	CMA
	DCA	XCTR	/USE AS A COUNTER
	TAD	C7700	/GIVE SEARCH A MASK TO USE ON LAST SYMBOL
	JMS	SEARCH	/LOOK FOR OCCURRENCE OF SYMBOL IN TABLE
	JMP	ZCHECK	/SYMBOL IS IN TABLE CHECK IT
	TAD	L57	/TELL ENTER WHERE TO PUT THE SYMBOL
	JMS	ENTER	/ENTER THE SYMBOL
	TAD	C3	/UPDATE THE POINTER
	DCA	L57	/AND SAVE IT
	DCA	L21	/ZERO SWITCH SINCE SYMBOL JUST LOADED
	ISZ	SCOUNT	/UPDATE COUNT OF SYMBOLS
	JMP	LOOP1	/GO BACK AND CHECK IT
ZCHECK,	TAD	L77	/GET POINTER INTO SYMBOL TABLE
	TAD	C2	/MOVE TO LAST WORD
	DCA	LSYMTM	/SAVE IT
	TAD I	LSYMTM	/GET THE CONTROL BITS
	AND	L21	/AND THE MASK
	SZA CLA		/ARE ANY ILLEGAL BITS ON
ERR54,	JMS I	LUNCH	/ERROR 54 ... PROBABLY IN EQUIVALENCING ...
	TAD	L32	/NOW OR IN NEW BITS
	CMA
	AND I	LSYMTM
	TAD	L32
	DCA I	LSYMTM
	JMP I	LSYMTB	/RETURN
/	FLOATING CONSTANT IS IN 30 THRU 32
LFCON,	0
	CLA
MLOOP,	TAD	L47	/GET BEGINNING OF FCON TABLE
	TAD	C3	/MOVE TO ACTUAL START OF TABLE
	DCA	LSYMTM	/AND SAVE
	TAD	FCOUNT	/GET NUMBER OF FCONS SO FAR
	CMA
	DCA	XCTR	/AND USE FOR A COUNTER
	CMA		/GIVE SEARCH A MASK FOR THE LAST WORD
	JMS	SEARCH	/SEARCH THE TABLE FOR THE CURRENT FCON
	JMP I	LFCON	/ITS ALREADY IN THERE JUST RETURN
	TAD	L47	/TELL ENTER WHERE TO PUT THE FCON
	JMS	ENTER	/ENTER THE FCON
	TAD	CM3	/AND UPDATE IT
	DCA	L47	/AND SAVE
	ISZ	FCOUNT	/UPDATE NUMBER OF FCONS
	JMP	MLOOP	/GO BACK AND CHECK
/	THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR
/	OCCURRENCES OF THE CURRENT SYMBOL OR FCON
SEARCH, 0
	DCA	ENTER	/SAVE THE MASK
MBACK,	ISZ	XCTR	/SEE IF WE HAVE PROCESSED ALL SYMBOLS
	SKP		/NO GO ON
	JMP	QRET	/YES
	TAD I	LSYMTM	/GET FIRST WORD OF SYMBOL
	CIA		/NEGATE
	TAD	L30	/SUBTRACT FIRST WORD OF CURRENT SYMBOL
	ISZ	LSYMTM	/INCREMENT POINTER
	SZA CLA 	/DO THEY MATCH
	JMP	I1	/NO GO TO NEXT SYMBOL
	TAD I	LSYMTM	/YES GET SECOND WORD OF SYMBOL
	CIA
	TAD	L31	/SUBTRACT SECOND WORD OF CURRENT SYMBOL
	ISZ	LSYMTM	/ADVANCE POINTER
	SZA CLA 	/DO THEY MATCH
	JMP	I2	/NO GO TO NEXT SYMBOL
	TAD I	LSYMTM	/SEE IF NEXT WORD MATCHES
	AND	ENTER	/MASK OUT DESIRED PORTIONS
	CIA
	TAD	L32	/SUBTRACT THIRD CURRENT WORD
	AND	ENTER	/K AGAIN
	ISZ	LSYMTM	/ADVANCE POINTER
	SZA CLA 	/DO THEY MATCH
	JMP	MBACK	/NO GO TO NEXT SYMBOL
	TAD	LSYMTM	/YES
	TAD	CM3	/MOVE BACK POINTYER
	DCA	L77	/PUT POINTER IN PAGE ZERO
	JMP I	SEARCH	/RETURN
QRET,	ISZ	SEARCH	/SET UP RETURN FOR	NOT FOUND
	JMP I	SEARCH	/RETURN
I1,	ISZ	LSYMTM	/ADVANCE POINTER
I2,	ISZ	LSYMTM	/ADVANCE PIINTER
	JMP	MBACK	/GO TO NEXT SYMBOL
/	THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED
ENTER,	0
	DCA	LSYMTM	/SAVE ADDRESS
	TAD	L47	/GET BEGINNING OF FCON TABLE
	CMA
	TAD	L57	/SUBTRACT END OF SYMBOL TABLE
C7700,	SMA CLA		/IS THERE ROOM FOR ANOTHER SYMBOL OR FCON
ERR17,	JMS I	LUNCH	/NO
	TAD	L30	/YES GEYT FIRST WORD
	DCA I	LSYMTM	/STORE IT
	TAD	LSYMTM
	DCA	L11	/SET UP AUTO - XR
	TAD	L31
	DCA I	L11
	TAD	L32
	DCA I	L11
	TAD	LSYMTM	/GET THE ADDRESS BACK INTO THE AC
	JMP I	ENTER	/AND RETURN
DUMPLN,	DMPLIN
LSYMTM=.
LPRINT,	0		/ CONVERTS FROM TRIMMED TO EIGHT BIT ASCII
	DCA	LFCON	/SAVE THE CHARACTER
	TAD	L75	/S GET THE SUPPRESS PRINTING WITCH
	SZA CLA
	JMP I	LPRINT
	ISZ	L24	/IS THIS A NEW LINE?
	SKP		/NO
	JMS I	DUMPLN	/YES - DUMP THE OLD ONE FIRST
	TAD	LFCON	/NO...GET THE CHARACTER
	SNA		/IS IT A CR
	JMP	CRLF	/YES...PUT OUT CRLF
	AND	C40	/CHECK BIT SIX
	CLL RAL
	CIA		/AC CONTAINS 0 OR -100
	TAD	C300	/NOW CONTAINS 300 OR 200
	TAD	LFCON	/NOW ADD THE CHARACTER IN
PRIT,	DCA I	L24	/AND STORE IT IN THE BUFFER
	JMP I	LPRINT
CRLF,	TAD	C215	/GET AN EIGHT BIT CR
	DCA I	L24	/STORE IT IN THE BUFFER
	ISZ	L24
	TAD	C212
	DCA I	L24	/STORE A LINE FEED TOO
	CLA CMA
	DCA	L24	/SET SWITCH TO DUMP LINE ON NEXT CHAR
	JMP I	.+1
	PRIT+1
LCOMON, CLA
	JMS I	LOOK	/CHECK REST OF STATEMENT NAME
		-2	/TWO CHARACTERS
		-17	/O
		-16	/N
GETVAR, JMS I	ENTITY	/GET A VARIABLE
	SKP		/NOT A VARIZBLE
	JMP	VARI	/WE GOT A VARIABLE
	NOP
B20,	20
ERR18,	JMS I	LUNCH	/ERROR
VARI,	TAD	C40
	TAD	L32	/PUT IN COMMON BIT
	DCA	L32
	TAD	K37	/GET MASK FOR SYMBOL TABLE SWITCH
	DCA	L21	/PUT IN THE SWITCH
	JMS I	SYMTAB	/PUT SYMBOL IN TABLE
	JMS I	ENTITY	/LOOK FOR A COMMA
	JMP	START	/THAT'S ALL GOT A CR-LF...
K37,	37
K27,	27
	JMP	.+3	/ERROR
	TAD	CM54	/CHECK FOR COMMA
	SZA CLA 	/IS IT A COMMA
	JMP	ERR18	/NO...ERROR
	JMP	GETVAR	/GET ANOTHER VARIABLE
LDIMEN,	JMS I	LOOK	/LOOK FOR REST OF STATEMENT
		-5	/FIVE CHARS
		-16	/N
		-23	/S
		-11	/I
		-17	/O
		-16	/N
QAGAIN,	CLA CMA 	/-U
	DCA	REDY	/SET SWITH FOR VARIABLE
QGET,	JMS I	ENTITY	/GET WHATEVER IS NEXT IN LINE
	JMP	QDONE	/IT EAS A CR
	JMP	.+4	/IT WAS A VARIABLE
	JMP	ASUBSC	/IT WAS ONE OF THE SUBSCRIPTS
	JMP	ERR18	/WE BETTER NOT GET ANY FP NUMBERS
	JMP	QPUNC	/IT WAS A PUNCTION
	ISZ	REDY
	JMP	ERR18	/WE WERENT READY FOR A VAR
	TAD	B20
	TAD	L32
	DCA	L32
	TAD	K27	/GET THE MASK FOR THE SYMBOL TABLE
	DCA	L21	/PUT IN THE SWITCH
	JMS I	SYMTAB	/PUT SYMBOL IN TABLE
	CMA CLA
	TAD	L47	/GET BEGINNING OF TABLE
	DCA	L16
	TAD	L77	/GET TABLE ADDRESS
	DCA I	L16
	CLA CMA
	DCA	V	/SET WITCH TO SAY WEVE GOTTEN A VAR
	JMP	QGET	/GET NEXT THING
QPUNC,	TAD	CM54
	SNA		/IS IT A COMMA
	JMP	COMMA	/YES
	TAD	C3
	SNA
	JMP	QRPAR	/RIGHT PAREN
	IAC
	SNA		/IS IT A LEFT PAREN
	ISZ	V	/PRECEDED BY A VAR
	JMP	ERR18	/NO - ERROR
	CLA CMA
	DCA	XLP	/SET SWITCH TO SHOW LPAR
	JMP	QGET
ASUBSC,	ISZ	XLP	/DID WE JUST GET LPAR
	JMP	SECOND	/NO...BETTER BE SECOND SUBSC
	TAD	L32	/GET INTEGER
	DCA I	L16	/PUT IN DIMTAB
	CMA CLA
	DCA	QONE	/SET SWITCH TO SHOW WE HAVE ONE SUBSC
	JMP	QGET
COMMA,	ISZ	QONE	/DOES THIS COMMA SEPARATE SUBSCS
	JMP	RIGHT	/NO...LAST CHAR BETTER HAVE BEEN L	RPAR
	CMA CLA
	DCA	SEC	/SET SWITCH TO EXPECT SECOND SUBSCRIPT
	JMP	QGET
SECOND, ISZ	SEC	/IS THIS SECOND SUBSCRIPT
	JMP	ERR18	/NO...ERROR
	TAD	32	/GET INTEGER
	DCA I	L16
	CMA CLA
	DCA	R	/SET SWITCH FOR RPAR
	JMP	QGET
QRPAR,	ISZ	QONE	/HAVE WE GOTTEN ONE SUBSC
	JMP	QTWO	/NO...CHECK FOR TWO
	IAC		/ONLY ONE SO USE 1 AS SECOND
	DCA I	L16
QBACK,	CMA CLA
	DCA	RIG
	TAD	L47	/GET BEGINNING OF TABLE
	DCA	L50	/SAVE IN LOW CORE
	TAD	L47
	TAD	CM3	/SUBTRACT THREE FROM ADDRESS
	DCA	L47	/AND SAVE
	JMP	QGET	/WE EXPECT COMMA OR CR
QTWO,	ISZ	R	/HAVE WE GOTTEN TWO
	JMP	ERR18	/NO...ERROR
	JMP	QBACK
RIGHT,	ISZ	RIG	/DID WE JUST GET RPAR
	JMP	ERR18	/NO...ERROR
	JMP	QAGAIN
QDONE,	ISZ	RIG
	JMP	ERR18
	JMP	START
QONE,	0
RIG,	0
R,	0
REDY,	0
V,	0
XLP,	0
SEC,	0
	*3000
LGOTO,	TAD	L74
	DCA	L16	/USE AUTO INDEXING
	DCA	L76
	JMS I	ENTITY
	NOP
	SKP
	JMP	ALAB	/WE HAVE A LABEL
	JMP I	ASSIGN	
	TAD	CM50	/IF PUNCT...CHECK FOR LEFT PAREN
	SZA CLA 	/IS IT (
	JMP I ASSIGN
ANEXT,	JMS I	ENTITY
	NOP
	SKP
	JMP	THERE	/WE HAVE A LABEL
	NOP
ERR28,	JMS I	LUNCH
THERE,	TAD	L32	/GET THE LABEL
	DCA I	L16	/PUT IN LIST
	ISZ	L76
	JMS I	GNB
	TAD	CM54	/CHECK FOR BEING A COMMA
	SNA		/IS IT A COMMA
	JMP	ANEXT	/YES GET ANOTHER LABEL
	TAD	C3	/CHECK FOR BEING A RIGHT PAREN
	SZA CLA 	/IS IT A )
	JMP I ASSIGN
	JMS I	GNB
	TAD	CM54	/CHECK FOR ANOTHER COMMA
	SZA		/IS IT ANOTHER
	JMS I	PUTCH	/IGNORE ANYTHING ELSE ...
	JMS I	ENTITY	/GET THE CONTROL VARIABLE
	SKP
	JMP	.+4	/WE GOT IT
	NOP
	NOP
ERR29,	JMS I	LUNCH
	DCA	L21	/ZERO THE SYMBOL TABLE SWITCH
	JMS I	SYMTAB	/PUT VARIABLE IN SYMBOL TABLE
	TAD	L77	/GET ADD RESS OF SYMBOL
	JMS I	MODE	/CHECK THE MODE OF THE VAIABLE
ERR30,	JMS I	LUNCH	/ITS FLOATING POINT
	JMS I	ZZZ	/PUT OUT STMT LABEL
	JMS	LXTAD	/LOAD VARIABLE WITH TAD OR TAD*
	JMS I	PROP	/PUT OUT OP CODE
Q6066,		6066	/OP CODE IS TAD
	JMS I	CREATE	/GET THE NEXT CREATED LABEL
	JMS I	PRCRL	/PRINT THE CREATED LABEL
	JMS I	PRINT	/PUT OUT CR LF
	JMS I	PROP	/PUT OUT OP CODE
		6071	/OP CODE IS DCA
	TAD	GO7
	JMS I	PROTAC
	JMS I	PRINT	/PUT OUT CRLF
	JMS I	PROP	/PUNCH 'TAD I 7'
		OPTADI
	TAD	GO7
	JMS I	PROTAC
	JMS I	PRINT
	JMS I	PROP	/PUNCH 'DCA 7'
		OPDCA
	TAD	GO7
	JMS I	PROTAC
	JMS I	PRINT
	JMS I	PROP	/PUNCH 'JMP I 7'
		OPJMPI
	TAD	GO7
	JMS I	PROTAC
	JMS I	PRINT
	TAD	L76	/PUNCH 'CPAGE <N+1>'
	IAC
	JMS I	PIFF
	TAD	L53	/PUNCH '<CR.LABEL2>, <CR.LABEL2>'
	JMS I	CLAB
	TAD	L53
	JMS I	PRCRL
	JMS I	PRINT
	TAD	L76	/NOW PUNCH THE LABELS
	CIA		/SET NEGATIVE
	DCA	L76
	TAD	L74
	DCA	L16	/USE AUTO INDEXING AGAIN
	TAD I	L16	/GET THE NEXT LABEL
	JMS I	PLAB	/PRINT THE LABEL
	JMS I	PRINT	/PUT OUT CRLF
	ISZ	L76
	JMP	.-4	/NO
	JMP	START
/	THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S
ALAB,	JMS I ZZZ
	TAD	L32
	JMS	PRJUMP	/PUT OUT A JUMP TO THE LABEL IN "L32"
	JMP	START

LXTAD,	0
	TAD	L77	/GET ADDRESS AGAIN
	JMS I	DUMARG
	TAD	CM3
	TAD	Q6066	/TAD OR TAD*
	DCA	OP	/USE AS OPERATOR
	JMS I	PROP	/PUT OUT OP CODE
OP,		0
	TAD	L77	/GET ADDRESS AGAIN
	JMS I	PRSYM	/PRINT THE SYMBOL
	JMS I	PRINT	/PUT OUT A CR LF
	JMP I	LXTAD

LLEAD,	0		/PUNCH SOME LEADER...
	DCA	L7
	JMS I	PUNCH
	ISZ	L7
	JMP	.-2
	JMP I	LLEAD
GO7,	7

PRJUMP,	0	/SUBROUTINE TO PUT OUT A JUMP
	DCA	LLEAD	/STORE THE LABEL
	JMS I	PROP
		6044	/JMP
	TAD	LLEAD
	JMS I	PLAB	/PUT OUT THE LABEL
	JMS I	PRINT	/PUT OUT A CRLF
	TAD	LLEAD
	DCA	L12	/SET CONTENTS OF LAST LINE TO LABEL
	JMP I	PRJUMP
	*3200
/	THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS

LPRTAC, 0
	DCA	TMP	/SAVE THE NUMBER
	DCA	TM
	TAD	CM4	/PUT OUT FOUR CHARACTERS
	DCA	DCTR	/CHARACTER COUNTER
BK,	TAD	TMP	/GET THE NUMBER
	RAL		/ROTATE IT LEFT ONE
	RTL		/ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT
	DCA	TMP	/SAVE THE ROTATED NUMBER
	TAD	TMP	/GET IT IN ACCUMULATOR
	AND	C3
	RAL		/GET THE DIGIT INTO THE LOW-ORDER AC
	ISZ	DCTR	/IS THIS THE LAST DIGIT?
	JMP	.+4	/NO, CONTINUE
	TAD	C60	/MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT
	JMS I	PRINT	/PRINT THE DIGIT
	JMP I	LPRTAC
	SZA		/DO WE HAVE A ZERO DIGIT?
	JMP	.+4
	TAD	TM
	SNA CLA		/YES, IS IT A LEADING ZERO?
	JMP	BK	/YES, IGNORE IT
	TAD	C60
	JMS I	PRINT
	ISZ	TM	/DON'T SUPPRESS ZEROS ANY MORE
	JMP	BK	/NOW...PUT OUT ANOTHER
TMP,	0
TM,	0
CM4,	-4
C60,	60
LIF,	TAD	CM4
	DCA	COUNT1	/SET UP COUNTER
	JMS I	GNB
	TAD	CM50	/CHECK FOR	LEFT PAREN
	SZA CLA 	/IS IT A (
	JMP I ASSIGN
	JMS I	PUTCH	/YES...PUT IT BACK FOR GENER
	JMS I ZZZ
	ISZ	L52	/SET BALANCED PARENS SWITCH FOR GENER
	ISZ	L44	/SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN
	JMS I	GENER	/NOW CALL GENER AND PROCESS EXPRESSION
	TAD I	L41
	JMS I	MODE	/WHAT IS ITS MODE
	JMS I	GETHI	/GET HI ORDER P.P. AC
	TAD	CDCA41
	DCA	LIFDCA	/SET UP INSTRUCTION TO STORE LABELS
LABL,	JMS I	ENTITY	/GET A LABEL
D34,	34
	SKP
	JMP	INTEG	/WE GO A LABEL
C46,	46
ERR31,	JMS I	LUNCH	/DIDNT GET A LABEL
INTEG,	TAD	L32	/GET THE LABEL
	ISZ	LIFDCA
LIFDCA,	.-.		/STORE LABELS IN L42 THROUGH L44
	DCTR=LIFDCA
	ISZ	COUNT1	/HAVE WE GOTTEN TOO MANY LABELS
	SKP		/NO
	JMP	ERR31	/YES
	JMS I	GNB
	SNA		/SEE IF ITS A CR
	JMP	.+5	/ITS A CR
	TAD	CM54	/CHECK FOR COMMA
	SZA CLA 	/IS IT A COMMA
	JMP	ERR31
	JMP	LABL	/YES
	ISZ	COUNT1	/DID WE GET THE RIGHT NUMBER OF LABELS
	JMP	ERR31	/NO
	TAD	L42
	CIA
	TAD	L44
	SNA CLA		/IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL
	JMP	ISPECL	/WE CAN SAVE SOME CODE
	TAD	L43
	CIA
	TAD	L44
	SNA CLA		/IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL
	JMP	SPCONL	/WE CAN ALSO SAVE SOME CODE
	JMS I	PROP	/PUT OUT OP CODE
		6105	/OP CODE IS SNA
	JMS I	PRINT	/PUT OUT CRLF
	TAD	L43
	JMS I	PRJMP	/OUTPUT THE ZERO BRANCH
SPCONL,	JMS I	PROP	/PUT OUT OP CODE
		6110	/OP CODE IS P SPA CLA
	JMS I	PRINT	/PUT OUT CRLF
	TAD	L42	/OUTPUT THE NEGATIVE BRANCH
IFCOMN,	JMS I	PRJMP
	TAD	L44
	JMS I	PRJMP	/OUTPUT THE POSITIVE (>0) BRANCH
	DCA	L46	/ZERO AC
	JMP	START	/GO GET NEXT STATEMENT
ISPECL,	JMS I	PROP	/PUNCH 'SNA CLA'
		OPSNA
	JMS I	PROP
		OPCLA
	JMS I	PRINT
	TAD	L43
	JMP	IFCOMN	/OUTPUT THE ZERO AND POSITIVE BRANCHES
PRJMP,	PRJUMP
COUNT1,	0
LCREAT, 0
	ISZ	L53	/INCREMENT BY ONE...
	TAD	L53
	AND	C77
	TAD	CM33
	SMA CLA		/HAVE WE BEEN HERE 26 TIMES?
	TAD	C46	/YES, BUMP THE HIGH ORDER DIGIT
	TAD	L53
	DCA	L53	/AND SAVE
	TAD	L53	/NOW RETURN IT IN AC
	JMP I	LCREAT	/RETURN
LPLAB,	0		/THIS PRINTS REGULAR LABELS
	DCA	TMP	/FIRST SAVE LABEL
	TAD	D34	/NOW PUNCH A '\'
	JMS I	PRINT
	TAD	TMP	/GET LABEL
	JMS I	DECOUT	/AND PRINT IT
	JMP I	LPLAB	/RETURN
GETHI,	LGETHI
CDCA41,	DCA	L41
CM33,	-33
DECOUT,	LDCOUT
	*3400
DORET,	JMP I	XDO
ISZDO,	JMS I	PROP
		6237	/INC
	TAD	L30
	JMS I	PRSYM
	JMS I	PRINT
	JMP	DOSUBT	/GO GENERATE THE LIMIT TEST
NUMB,	0
SWIT,	0
DM5,	-5
CM24,	-24
C5001,	5001
LEQI,	EQI

LDO,	JMS I	ZZZ
	JMS I	ENTITY	/LOOK FOR THE SCOPE LABEL
C55,	55
	SKP
	JMP	SLAB	/WE GOT THE SCOPE LABEL
E53,	53
	JMP I ASSIGN
SLAB,	TAD	L32	/GET THE INTEGER
	JMS	XDO	/PUT OUT DO-LOOP CODE
	JMP	START	/NORMAL EXIT
	JMP	ERR35	/IMPLIED DO EXIT - ERROR

XDO,	0		/DO LOOP SUBROUTINE - ENTERED WITH
			/TARGET LABEL IN AC
	DCA I	L15	/PUT IN DO END PUSH DOWN LIST
	TAD	L74
	DCA	L16	/SET UP LIST OF DO ENDS
	DCA	L21	/ZERO THE SYMBOL TABLE SWITCH
	CMA CLA
	DCA	SWIT	/SET SWITCH FOR CONTROL VARIABLE
	TAD	DM5
	DCA	NUMB	/SET COUNTER OF NUMBER OF PARAMETERS
GETMOR, JMS I	ENTITY	/LOOK FOR A PARAMETER
	JMP	.+3	/ERR
	JMP	CVAR	/GOT A VARIABLE
	JMP	DPAR	/GOT AN INTEGER
C21,	21
	JMP	ERR35
CVAR,	JMS I	SYMTAB	/PUT SYMBOL IN TABLE
	TAD	L77	/GET ADDRESS
	JMS I	MODE	/DETERMINE MODE OF SYMBOL
	JMP	ERR35
	TAD	L77	/GET ADDRESS AGAIN
DOSTOR,	DCA I	L16	/SAVE
	ISZ	NUMB	/HAVE WE GOTTEN TOO MANY PARAMS
	SKP		/NO
ERR35,	JMS I	LUNCH	/YES, DO ERROR ...
	JMS I	GNB
	SNA		/IS IT CR
	JMP	ALLDNE+1	/YES WERE DONE
	TAD	CM51
	SNA		/IS IT A RIGHT PAREN?
	JMP	ALLDNE	/YES-FINISH UP AND TAKE IMPLIED DO EXIT
	TAD	CM24
	SZA		/IS IT =
	JMP	MCOM	/NO
	ISZ	SWIT	/IS SWITCH SET FOR IT
	JMP	ERR35	/NO
	JMP	GETMOR	/YESS...GO BACK FOR ANOTHER PARAMETER
MCOM,	TAD	C21	/CHECK FOR COMMA
	ISZ	SWIT	/IF NO EQUAL SIGN YET
	SZA		/OR IF THIS ISN'T A COMMA
	JMP	ERR35	/THEN ITS AN ERROR
	JMP	GETMOR	/GET ANOTHER
DPAR,	TAD	L32	/GET THE INTEGER
	ISZ	SWIT	/HAVE WE SEEN AN EQUAL SIGN?
	JMP	DOSTOR	/YES - SAVE THE INTEGER AND PROCEED
	JMP	ERR35	/NO
ALLDNE,	ISZ	XDO	/BUMP RETURN POINTER IF TERMINATOR WAS RPAR
	CLA IAC
	DCA I	L16	/STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT
	TAD	C2
	TAD	NUMB
	SPA CLA		/DID WE GET AT LEAST THREE ARGS?
	JMP	ERR35	/NO
	ISZ	L44
	TAD	L74	/GET ERASABLE LOCATIONS
	DCA	L16	/USE THE AUTO INDEX REGISTERS
	TAD I	L16	/GET CONTROL VARIABLE
	DCA	L30	/AND PUT IN THIRTY
	TAD I	L16	/GET INITIAL VALUE
	DCA	L31	/AND SAVE IT
	TAD I	L16	/GET FINAL VALUE
	DCA	L32	/AND SAVE IT
	TAD I	L16	/GET INCREMENT
	DCA	L33	/AND SAVE IT
	TAD	L74	/GET ADDR OF ERASABLE AGAIN
	IAC		/INCREMENT ONCE
	DCA	L41	/TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES
	TAD	L74	/GET IT AGAIN
	DCA	L16	/USE AUTO INDEX TO STORE TRIPLE
	DCA	L46	/ZERO THE AC
	TAD	C5001	/SET UP INITIAL TRIPLE NUMBER
	DCA	L40
	TAD	L33
	CIA
	TAD	L31
	SNA CLA		/IF INITIAL VALUE = STEP SIZE
	JMP	STCTLV	/NO NEED TO COMPUTE THE DIFFERENCE
	TAD	L33	/GET STEP SIZE
	DCA I	L16	/PUT IN TRIPLE
	TAD	C55	/PUT IN A MINUS SIGN
	DCA I	L16
	TAD	L31	/GET INITIAL VALUE
	DCA I	L16
	JMS I	TRIPL	/PROCESS THE TRIPLE
STCTLV,	JMS I	LEQI	/STORE ANSWER IN CONTROL VARIABLE
	JMS I	CLAB	/PUT A CDREATED LABVEL ON THE NEXT STATEMENT
	TAD	L53	/GET THE CREATED LABEL
	DCA I	L15	/AND PUT IN	DO END LIST
	TAD	L74
	DCA	L16
	TAD	L33	/GET STEP SIZE
	CLL RAR
	SNA		/IF STEP SIZE=1 THEN
	JMP	ISZDO	/WE CAN USE AN ISZ TO INCREMENT
	RAL
	DCA I	L16
	TAD	E53	/WERE GOING TO ADD
	DCA I	L16
/	L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI"
	JMS I	TRIPL	/ADD STEP SIZE TO CONTROL VARIABLE
	JMS I	LEQI	/STORE ANSWER IN CONTROL VARIABLE
DOSUBT,	TAD	L74
	DCA	L16
	TAD	L30	/GET THE CONTROL VARIABLE
	DCA I	L16
	TAD	C55	/WERE GOING TO SUBTRACT
	DCA I	L16
	TAD	L32	/GET FINAL VALUE
	DCA I	L16
	JMS I	TRIPL	/SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
	DCA	L46	/CLEAR THE AC FLAG
	JMS I	PROP
		6110	/SPA CLA
	JMS I	PRINT
	JMS I	PROP
		6044	/PUT OUT A JMP
	JMS I	CREATE	/TO A CREATED LABEL
	DCA I	L15	/PUT CREATED LABEL IN DO END LIST
	TAD	L53	/GET LABEL
	JMS I	PRCRL	/AND PRINT IT
	JMS I	PRINT	/CRLF
	ISZ	L55	/INCREMENT UNENDED DO COUNTER
	SKP
ERR38,	JMS I	LUNCH	/TOOO MANY UNENDED DOS
	JMP I	.+1
	DORET		/RETURN FROM SUBROUTINE "XDO"

EQI,	0
	TAD	L74
	DCA	L16
	TAD	L46	/GET RESULT OF PREVIOUS COMPUTATION
	DCA I	L16
	TAD	E75	/GET EQUALS SIGN
	DCA I	L16
	TAD	L30	/GET CONTROL VARAIBLE
	DCA I	L16
	JMS I	TRIPL	/PROCESS
	DCA	L46	/WIPE AC SWITCH
	JMP I	EQI	/RETURN
LFUNCT,	0
	DCA	ARGCNT
	TAD	L46	/GET AC
	SZA CLA 	/IS IT ZERO
	JMS I	STORE	/NO...STORE THE AC
	TAD	L53	/GET CURRENT CREATED LABEL
	DCA	L73	/AND SAVE
	CLA CMA 	/AC IS MINUS ONE
	TAD	L41	/PUSH LIST POINTER
	DCA	L42	/PUSH LIST POINTER MINUS ONE
CKFNCT,	ISZ	L42	/INCREMENT POINTER
	ISZ	L42	/AGAIN
	TAD I	L42	/GET	THE OPERATOR
	TAD	CM4047	/SUBTRACT THE FUNCTION OPERATOR
	SZA	 	/IS THIS THE FUNCTION OPERATOR
	JMP	CKSBSC	/NO
	CLA IAC 	/YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO
	TAD	L42	/THIS POINTS TO IT
	DCA	SAVE	/AND SAVE
	TAD I	SAVE
	TAD	C2
	DCA	EQI
	TAD I	EQI
	AND	CM2
	IAC
	DCA I	EQI
MOR,	CLA CMA 	/NOW EXAM THE ARGUMENTS
	TAD	L42	/WERE POINTING TO THE FIRST ARGUMENT
	DCA	L42	/SAVE THE POINTER
	ISZ	ARGCNT
	JMS I	LCHNG	/CHECK L42 FOR ZERO OR DUMMY ARG
	DCA I	L42	/REPLACE IT BY UPDATED VALUE
	TAD	L42	/IT WASNT...SEE IF IT WAS THE LAST ARGUMENT
	CIA
	TAD	L41	/SUBTRACT THE END OF ARGUMENT LIST
	SNA CLA 	/IS IT ZERO
	JMP	OUT	/YES...WE'VE COMPLETED THIS PHASE
	CLA CMA 	/NO...MOVE THE POINTER BACK ONE
	TAD	L42
	DCA	L42	/AND SAVE
	JMP	MOR	/NOW CHECK THE NEXT ARGUMENT
OUT,	TAD	SAVE	/GET THE POINTER TO THE FUMCTION NAME AGAIN
	DCA	L42	/AND PUT IN 42
	TAD I	L42	/GET THE ARGUMENT
	DCA	FUNOP	/USE FPROP TO PUT OUT THE CALL TO THE FUNCTION
	TAD	ARGCNT	/GIVE FPROP THE NUMBER OF ARGUMENTS
	JMS I	FPROP	/PUT OUT THE CALL TO THE FUNCTION
FUNOP,	0
	TAD	L73	/NOW RESTORE THE CREATED LABEL LOCATION
	DCA	L53
MNEXT,	TAD	L42	/GET THE POINTER
	TAD	CM2	/MOVE POINTER TO ARGUMENT
	DCA	L42	/AND SAVE
	TAD I	L42	/GET NEXT ARGUMENT
	JMS I	PSYMOT	/GENERATE AN "ARG" FOR THE ARGUMENT
	TAD	L42	/GET THE POINTER
	CIA		/SET IT NEGATIVE
	TAD	L41	/ADD
	SZA CLA 	/ARE THEY EQUAL
	JMP	MNEXT	/NO THERE ARE MORE ARGS
	TAD I	SAVE	/YES...GET THE FUNCTION NAME
	JMS I	MODE	/WHAT MODE IS IT
	TAD	E400	/ITS FLOATING POINT
	TAD	L40	/ITS INTEGER
	DCA	L46	/PUT THE TRIPLE NUMBER IN THE AC SWITCH
	TAD	SAVE	/YES...CHANGE PUSH LIST POINTER
	DCA	L41	/STORE POINTER TO NAME IN PUSH LIST POINTER
	TAD	L46	/GET CURRENT TRIPLE NUMBER
	DCA I	L41	/AND PUT IT IN THE PUSH LIST
	JMP I	LFUNCT	/RETURN
CKSBSC,	IAC
	SZA CLA		/IS IT THE SUBSCRIPT OPERATOR?
	JMP	CKFNCT	/NO - KEEP LOOKING
	JMP I	.+1
	ERR39
PSYMOT,	SYMOUT
SAVE,	0
ARGCNT, 0
E75,	75
CM4047,	-4047
E400,	400

	TAD	C47
	JMS I	PPACK
LQUOTE,	JMS I	PGTC	/GET A CHARACTER
	SNA
ERR37,	JMS I	LUNCH	/CARRIAGE RETURN - ERROR
	TAD	CM47
	SZA
	JMP	LQUOTE-2	/IF NOT A QUOTE, STORE IT
	JMP I	.+1
	FRET
C47,	47
CM47,	-47
PGTC,	LGTC
PPACK,	PACK
	*4000
LCONT,	JMS I	LOOK	/CHECK REST OF LINE
		-4	/LOOK FOR FOUR CHARACTERS
		-11	/I
		-16	/N
		-25	/U
		-5	/E
	JMS I	ZZZ
	JMS I	PROP	/PUNCH 'NOP'
		6047
	JMS I	PRINT	/PUT OUT A CRLF
	JMP	START	/GO GET NEXT STATEMENT

LPAUSE,	JMS I	LOOK	/CHECK REST OF STATEMENT TYPE
		-1	/JUST ONE CHARACTER
		-5	/E
	CLA CMA
LSTOP,	DCA	SW	/SET SWITCH FOR STOP OR PAUSE
	DCA	L32
	JMS I	ENTITY	/LOOK FOR THE OPTIONAL INTEGER
	JMP	MCR	/WE GOT A CR
	SKP		/ERR
	JMP	.+3	/WE GOT AN INTEGER
	NOP		/ERR
	JMP I ASSIGN

MCR,	JMS I ZZZ
	ISZ	SW	/PAUSE OR STOP?
	JMP	STOP
	JMS I	FPROP	/PUNCH 'CALL 0,CKIO'
	6116
	JMS I	PROP	/PRINT OP CODE
		6066	/OPCODE IS TAD
	TAD	L32	/GET THE INTEGER
	JMS I	PRSYM	/PRINT IT
	JMS I	PRINT	/CR
	JMS I	PROP
		6121
	JMS I	PRINT
	JMS I	PROP
		6124
	JMS I	PRINT	/PUT OUT CRLF
	JMP	START	/GO GET NEXT STATEMENT

STOP,	JMS	OSTOP
	JMP	START

OSTOP,	0		/PUNCH 'CALL 0,CKIO'
	JMS I	FPROP
		6116
	JMS I	CLAB	/PUNCH '<LAB>, HLT'
	JMS I	PROP
		6121
	JMS I	PRINT
	JMS I	PROP	/PUNCH 'JMP <LAB>'
		6044
	TAD	L53
	JMS I	PRCRL
	JMS I	PRINT
	JMP I	OSTOP

SW,	0
LFRMAT, JMS I	LOOK	/CHECK REST OF STATEMENT TYPE
		-2	/TWO CHARACTERS
		-1	/A
		-24	/T
	ISZ	OSTOP
	TAD	L74
	DCA	L10
	DCA	L76
	JMS I PROP
	6044
	JMS I CREATE
	JMS I PRCRL
	JMS I PRINT
	JMS I	GNB	/READ UNTIL A PAREN IS GOTTEN
	TAD	CM50	/SUBTRACT A (
	SZA CLA 	/IS IT A (
ERR39,	JMS I	LUNCH	/NO...ILLEGAL CHARACTER
	TAD	C50	/GET A LEFT PAREN
	JMP	PAREN	/AND GO START COUNTING PARENS
AGAIN,	JMS I	GTC
	SNA		/IS IT A CR
	JMS I	PUTCH	
PAREN,	RTL CLL 	/SHIF CHAR LEFT
	RTL
	RTL
	DCA	L32	/SAVE THE CHAR
	JMS I	GTC
	SNA		/IS IT A CR
	DCA	OSTOP
	TAD	L32	/PACK THE TWO CHARS
	DCA I	L10
	ISZ	L76
	TAD	OSTOP	/GET BALANCED PAREN SWITCH
	SZA CLA 	/ARE THEY BALANCED
	JMP	AGAIN	/NO GET SOME MORE CHARS
	TAD	L76
	JMS I	PIFF
	TAD	L74
	DCA	L10
	TAD	L76
	CIA
	DCA	L76
	JMS I	ZZZ
	TAD I	L10
	JMS I	PROTAC
	JMS I	PRINT
	ISZ	L76
	JMP	.-4
	TAD	L53	/PUNCH '<LABEL>,'
	JMS I	CLAB
	JMS I	PRINT
	JMP	START
GTC,	LGTC
PXSUBR,	XXSUBR
C50,	50

LPIFF,	0		/PUNCH 'IFF <N>'
	DCA	LZZZ	/ENTER WITH N IN THE AC
	JMS I	PROP
		6102
	TAD	LZZZ
	JMS I	PROTAC
	JMS I	PRINT
	JMP I	LPIFF

LZZZ,	0		/PUNCH THE CURRENT LABEL, IF ANY
	TAD	L54
	SNA		/IS THERE A LABEL?
	JMP	ZZZRET	/NO
	JMS I	PLAB	/PUNCH '<LABEL>, '
	TAD	C7240
	JMS I	P2
ZZZRET,	DCA I	PXSUBR	/MAKE SUBROUTINES AND FUNCTIONS ILLEGAL
	JMP I	LZZZ
	*4200
LTRIPL,	0
	JMS I	XZQL	/FIRST CHECK IF A TRIPLE IS LEGAL HERE
	TAD	L41	/GET PUSH LIST POINTER
	IAC		/INCREMENT TO POINT TO OPERATOR
	DCA	L42	/OPERATOR POINTER
	TAD	L42	/GET IT AGAIN
	IAC		/INCREMENT IT
	DCA	L43	/OPERAND TWO POINTER
	TAD I	L42	/GET OPERATOR
	AND	C77	/MASK GARBAGE BITS
	TAD	CM41	/SUBTRACT AN ADD INDIRECT OPERATOR
	SNA CLA 	/IS OPERATOR  <DOLLAR>
	JMP I	LADDIN	/YES PROCESS IT
	TAD I	L43	/NO...GET OPERAND TWO
	JMS I	DUMARG	/SEE IF ITS A DUMMY ARGUMENT
	SKP		/YES IT IS
	JMP	CK2	/NO ..CHECK THE OTHER ARGUMENT
	TAD I	L42	/YES	GET THE OPERATOR
	AND	C77	/MASK GARBAGE BITS
	TAD	EM75	/IS IT AN EQUALS SIGN
	SNA		/IS OP C
	JMP	LEQUIN	/YES USE C*
	IAC		/SEE IF ITS ALREADY EQUALS INDIRECT
	SZA CLA 	/IS OP C*
	JMS I	LDUMTW	/YES TWO IS DUMMY ARG
CK2,	CLA
	TAD I	L41	/NO IS OPND ONE A SYMBOL
	JMS I	DUMARG	/SEE IF ITS A DUMMY ARGUMENT
	JMS I	LDUMON	/IT IS
	CLA CLL 	/NOW LETS SEE WHAT THE OPERATOR IS
	TAD I	L42	/GET THE OPERATOR
	AND	C77	/MASK OUT GARBAGE BITS
	TAD	CM53
	SNA		/IS IT  
	JMP I	LAADD	/YES
	IAC
	SNA		/IS IT *
	JMP I	LMUL	/YES
	TAD	CM3
	SNA		/IS IT -
	JMP I	LASUB	/YES
	TAD	CM2
	SNA		/IS IT /
	JMP I	LDIV	/YES
	TAD	CM16
	SNA		/IS IT C
	JMP I	LEQU	/YES
	IAC
	SNA		/IS IT C*
	JMP I	LEIND	/YES
	TAD	J27
	SNA		/IS IT **
	JMP I	LEXP	/YES
	TAD	C2
	SNA		/IS IT A UNARY MINUS
	JMP I	LUMIN	/YES
ERR40,	JMS I	LUNCH	/NO BETTER COP OUT
LDMARG, 0
	SMA		/IS HIGH ORDER BIT ON
	JMP	INC	/NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER
	RAL		/GET NEXT BIT
	SMA		/IS IT ON
	JMP	MAYBE	/NO...WE MIGHT HAVE A SUBSCRIPT THOUGH
	RAR		/YES...RESTOR THE PARAMETER
	CIA		/SET IT NEGATIVE
	TAD	L47	/SUBTRACT IT FROMTHE START OF THE FCON TABLE
	SPA		/IS THE RELULT POSITIVE
	JMP	INC	/NO...ITS AN FCON NOT A SYMBOL
	CIA		/YESS...RESTORE ORIGINAL PARAMETER
	TAD	L47
	TAD	C2	/YES	MOVE POINTER TO CONTROL BITS
	DCA	L23	/SAVE
	TAD I	L23	/GET THE CONTROL BITS
	AND	C10	/MASK ALL BUT DUMMY ARG BIT OUT
INC1,	SNA CLA 	/IS THIS SYMBOL. A DUMMY ARG
INC,	ISZ	LDMARG	/NO...INCREMENT THE RETURN
	CLA		/CLEAR THE ACCUMULATOR
	JMP I	LDMARG	/AND RETURN
MAYBE,	AND	F400	/MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER
	JMP INC1	/AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG
ARET,	JMP I	LTRIPL	/THIS IS THE RETURN FROM TRIPLE

LEQUIN,	TAD	C74
	DCA I	L42	/SET OP TO =*
	JMP	CK2
C74,	74
/
/	THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT
LLOOK,	0
	JMS	GLOOK	/GET CHARACTER COUNT
	DCA	LTRIPL
ABACK,	JMS I	GNB
	JMS	GLOOK	/ADD IN THE TEST CHAR
	SZA CLA 	/WERE THEY EQUAL
	JMP I	ASSIGN	/NO...IT MUST BE AN ASSIGNMENT STATEMENT
	ISZ	LTRIPL	/THEY MATCH...ARE WE DONE
	JMP	ABACK	/NO
	JMP I	LLOOK	/RETURN

GLOOK,	0
	CDF 10
	TAD I	LLOOK
	ISZ	LLOOK
	CDF 00
	JMP I	GLOOK
/
LAADD,	AADD
LADDIN,	ADDIND
LASUB,	ASUB
LEQU,	EQU
LEIND,	EIND
LEXP,	EXP
LUMIN,	UMIN
CM41,	-41
EM75,	-75
LDUMTW,	DUMTWO
CM16,	-16
C10,	10
F400,	400
LDUMON,	DUMONE
CM53,	-53
LMUL,	MUL
LDIV,	DIV
XZQL,	LXZQ
J27,	27
	*4400
 /	FIGURE OUT WHATS IN AC
LCHECK,	0
	TAD	L46	/GET WHATS IN THE AC
	CIA		/SET NEGATIVE
	TAD I	L41	/SUBTRACT
	SNA CLA 	/ARE THEY EQUAL
	JMP	ONE	/YES
	TAD	L46	/GET AC AGAIN
	CIA		/SET NEGATIVE
	TAD I	L43	/SUBTRACT TWO
	SNA CLA 	/ARE THEY EQUAL
	JMP	TWO	/YES
	TAD	L46	/GET THE AC
	SNA CLA 	/IS IT ZERO
	JMP	NONE	/NO	YES YES YES
	JMP	SOME	/JUST SIMETHING IN AC
ONE,	ISZ	LCHECK
NONE,	ISZ	LCHECK
SOME,	ISZ	LCHECK
TWO,	JMP I	LCHECK

/	FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO

LTMPOR,	0
	DCA	LFPROP	/SAVE TRIPLE NUMBER
	TAD	LFPROP
	JMS I	MODE	/DETERMINE ITS MODE
	TAD	C30	/FLOATING POINT
	TAD	TTAB	/INTEGER
	DCA	LCHECK
	TAD	CM30
	DCA	FOP	/SET UP COUNT FOR SEARCH
LTLP1,	TAD I	LCHECK
	CIA
	TAD	LFPROP
	SNA CLA		/IS THIS THE ONE?
	JMP	ZEROIT	/YES - ZERO IT OUT AND RETURN IT
	ISZ	LCHECK
	ISZ	FOP
	JMP	LTLP1	/LOOP OVER ENTIRE TABLE
	TAD	LCHECK	/NOT FOUND - WE HAVE TO ASSIGN IT
	TAD	CM30
	DCA	LCHECK	/RESET POINTERS FOR ZERO SEARCH
	TAD	CM30
	DCA	FOP
LTLP2,	TAD I	LCHECK
	SNA CLA		/IS THIS TEMPORARY FREE?
	JMP	TEMPTY	/YES
	ISZ	LCHECK
	ISZ	FOP
	JMP	LTLP2	/CHECK THEM ALL
ERR41,	JMS I	LUNCH	/OUT OF TEMPORARIES
TEMPTY,	TAD	LCHECK
	CIA
	TAD	L45
	SNA CLA		/ADJUST THE NUMBER OF FLOATING POINT TEMPS
	ISZ	L45
	TAD	LCHECK
	CIA
	TAD	L51
	SNA CLA		/ADJUST THE NUMBER OF INTEGER TEMPS
	ISZ	L51
	TAD	LFPROP	/STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT
ZEROIT,	DCA I	LCHECK
	TAD	FOP
	TAD	C31	/GET POSITIVE NUMBER FROM TABLE COUNTER
	JMP I	LTMPOR	/RETURN
C31,	31

LFPROP,	0		/THIS ROUTINE PUNCHES SUBROUTINE CALLS
	DCA	FOP	/SAVE THE NUMBER OF ARGUMENTS
	JMS I	PROP
		6113	/PUT OUT THE CALL
	TAD	FOP	/GET THE NUMBER OF ARGUMENTS
	JMS I	PROTAC	/PRINT IT
	TAD	C54	/GET A COMMA
	JMS I	PRINT	/PRINT IT
	CDF 10
	TAD I	LFPROP
	CDF 00
	JMS I	PRSYM
	JMS I	PRINT
	ISZ	LFPROP	/INCREMENT RETURN
	JMP I	LFPROP	/RETURN
FOP,	0
/	COME HERE IF OP IS -
ASUB,	JMS I	SMODE	/MAKE SURE THAT BOTH ARGS ARE OF SAME MODE
	TAD I	L43	/GET OPERAND TWO
	JMS I	MODE
	JMP	FSUB	/ITS FLOATING POINT
	JMS	LCHECK	/ITS INTEGER...CHECK WHATS IN THE AC
	JMP	STWO	/TWO IS IN THE AC
	JMS I	STORE	/SMETHING IS IN THE AC
	JMS I	LADDON	/NOTHING IS IN THE AC...ADD ONE TO IT
ASBCMN,	JMS I	LCOMP	/ONE IS IN AC...COMPLEMENT IT
	JMS I	LADDTW	/ADD TWO TO IT
	JMP I	LRETUR	/AND RETURN
STWO,	JMS I	LCOMP	/TWO IS IN AC...COMPLEMENT IT
	JMS I	LADDON	/ADD ONE TO IT
	JMS I	LCOMP	/AND COMPLEMENT IT AGAIN
	JMP I	LRETUR	/AND RETURN
FSUB,	JMS	LCHECK	/FLOATING POINT...CHECK THE AC
	JMP	FS	/TWO IS IN AC
	JMS I	STORE	/SOMETHING IN AC...STORE IT
	JMP	FAS	/NOTHING IN AC
	JMP	ASBCMN	/ONE IS IN AC - COMPLEMENT AND ADD TWO
FAS,	JMS I	LADDTW	/NOTHING IN AC...ADD TWO IN
FS,	IAC		/WE HAVE ONE ARG
	JMS I	FPROP
		6011
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	TAD I	L41	/GET ARGUMENT ONE
IRET,	JMS I	PRSYM	/AND PUT IT OUT
	JMS I	PRINT	/PUT OUT CRLF
	JMP I	LRETUR
TTAB,	ITTAB		/THIS IS THE STARTING ADDRESS OF THE TEMP TABLE
LCOMP,	COMP
LADDON,	ADDONE
C30,	30
CM30,	-30
LRETUR,	RETURN
LADDTW,	ADDTWO
	*4600
/	PROCESS  *
ADDIND, JMS I	CHECK	/CHECK WHATS IN THE AC
	NOP		/TWO IS IN AC
	SKP		/N SOMETHING IS IN AC
	SKP		/NOTHING IS IN AC
	JMS I	STORE	/STORE WHATEVER IS IN AC
	TAD I	L41	/GET OPERAND ONE
	JMS I	MODE	/WHAT MODE IS IT
	JMP	FLOT	/YES	IT FLOATING POINT
	JMS I	PROP	/IST INTEGER...
		6063	/PUT OUT A TAD*
LOOP6,	TAD I	L41	/GET THE FIRST OPERAND AGAIN
	JMP I	LIRET	/GO TO THE RETURN ROUTINE
FLOT,	IAC		/WE ONLY HAVE ONE ARG
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
		6132	/PUT OUT A CALL TO FLOATING INDIRECT ADD
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	JMP	LOOP6	/AND JUMP BACK
/	THIS PUTS OUT OPCODES FOR AN ADD
ADDL,	0
	CLL RAR
	SNA		/TEST FOR 0 OR 1
	JMP	ADSPCL
	RAL		/NOT 0 OR 1, TREAT NORMALLY
	JMS I	MODE	/WHAT MODE ARE WE IN
	JMP	LOOP7	/YES
	JMS I	PROP	/PUT OUT A TAD
		6066
	JMP I	ADDL	/RETURN
LOOP7,	IAC		/WE ONLY HAVE ONE ARGUMENT
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
		6003	/PUT OUT A FLOATING ADD
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	JMP I	ADDL	/AND RETURN
ADSPCL,	ISZ	ADDL
	ISZ	ADDL	/BUMP RETURN POINT PAST ARGUMENT TO "TAD"
	SNL		/0?
	JMP I	ADDL	/YUP - DON'T PUT OUT NUTTIN
	JMS I	PROP
	OPIAC		/PUT OUT "IAC"
	JMP I	ADDL

/	STORES CONTENTS OF AC IN TEMPORARY
/	PUT OUT DCA OR CALL STO
/	FOLLOWED BY THE TEMPORARY LOC
LSTORE,	0
	TAD	L46	/GET THE AC
	JMS I	MODE	/WHAT MODE IS IT
	JMP	FSTO	/ITS FLOATING POINT
	JMS I	PROP
		6071	/ITS INTEGER...PUT OUT A DCA
STORET, TAD	L46	/GET THE AC AGAIN
	JMS I	PRSYM	/PRINT WHATEVER IS IN IT
	JMS I	PRINT	/PUT OUT A CRLF
	DCA	L46	/ZERO THE AC
	JMP I	LSTORE	/AND RETURN
FSTO,	IAC		/WE ONLY HAVE ONE ARG
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
		6006	/PUT OUT A CALL TOFLOATING STORE
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	JMP	STORET	/AND JMP BACK
COMP,	0
	TAD	L46	/GET THE AC
	JMS I	MODE	/WHAT MODE IS IT
	JMP	FCOM	/ITS FLOATING POINT
	JMS I	PROP	/ITS INYTEGER
		6135	/PUT OUT A CIA
	JMS I	PRINT	/PUT OUT A CRLF
	JMP I	COMP	/AND RETURN
FCOM,	JMS I	FPROP
		6140	/TO FLOATING CHANGE SIGN
	JMP I	COMP
/	COME HERE IF OP IS *
MUL,	JMS I	SMODE	/CHECK FOR SAME MODE
	JMS I	CHECK	/CHECK WHATS IN THE AC
	JMP	TMUL	/TWO IS IN THE AC
	JMS I	STORE	/SOMETHING IS IN AC...STORE IT
	JMS I	KADDON	/NOTHING IS IN AC..GET ONE IN AC
AMUL,	TAD I	L43	/GET OPERND TWO
	JMS I	MODE	/WHAT MODE IS IT
	TAD	EM6
	TAD	C6022
	DCA	FML	/SAVE OPCODE
	IAC
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
FML,		0
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	TAD I	L43	/GET OPERAND TWO
	JMP I	LIRET	/AND GO TO THE RETURN ROUTINE
TMUL,	TAD I	L41	/GET OPERAND ONE AND REPLACE OPERAND TWO
	DCA I	L43
	JMP	AMUL	/AND JUMP BACK
KADDON,	ADDONE
LIRET,	IRET
EM6,	-6
C6022,	6022
	*5000
/      THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG
DUMTWO, 0
	TAD I	L41	/GET OPND ONE
	DCA	FDV	/AND SAVE
	TAD I	L43	/GET OPND TWO
	DCA I	L41	/ZERO OPND ONE
	JMS	DUMONE	/PROCESS DUMMY ARGUMENT
	TAD	FDV	/GET SAVED OPERAND
	DCA I	L41	/AND USE AS OPERAND
	TAD	L46	/GET TRIPLE NUMBER
	DCA I	L43	/AND REPLACE
	JMP I	DUMTWO	/RETURN
/	TAKES CARE OF ONE BIING DUMMY ARG
DUMONE, 0
	TAD I	L42	/GET OPERATOR
	DCA	ASTOP	/AND SAVE
	TAD	E41	/GET ADD INDIRECT OPERATOR
	DCA I	L42	/AND REPLACE OPERATOR
	CDF 10
	TAD I	TRIPL
	CDF 00
	DCA	FEX	/AND SAVE RETURN
	JMS I	TRIPL	/CALL TRIPL
	TAD	L46	/GET TRIPLE NUMBER
	DCA I	L41	/AND REPLACE OPERAND
	TAD	ASTOP	/RESTORE OPERATOR
	DCA I	L42
	ISZ	L40	/ADVANCE TRIPLE
	TAD	FEX	/RESTORE RETURN
	CDF 10
	DCA I	TRIPL
	CDF 00
	JMP I	DUMONE	/RETURN
/	COME HERE IF OP IS /
DIV,	JMS I	SMODE	/CHECK FOR SAME MODE
	JMS I	CHECK	/CHECK WHATS IN THE AC
	JMP	DIVE	/TWO IS IN AC
	JMS I	STORE	/THERES SOMETHING IN THE AC...STORE IT
	SKP		/NOTHING IS IN AC
	JMS I	STORE	/THERES SOMETHING IN THE AC...STORE IT
	JMS I	MADDTW	/GET TWO INTO THE AC
DIVE,	TAD I	L41	/GET OPERAND ONE
	JMS I	MODE	/WHAT MODE IS IT
	TAD	FM6
	TAD	C6025
	DCA	FDV	/SAVE OERATOR
	IAC
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
FDV,		0
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	TAD I	L41	/GET OPERAND ONE
	JMP I	MIRET	/JUMP TO RETURN ROUTINE
/	COME HERE IF OP IS **
EXP,	JMS I	CHECK	/CHECK WHATS IN THE AC
	JMP	FEXP	/TWO IS IN AC
	JMS I	STORE	/THERES SOMETHING IN THE AC...STORE IT
	SKP		/NOW NOTHING IS IN AC
	JMS I	STORE	/THERES SOMETHING IN THE AC...STORE IT
	JMS I	MADDTW	/GET TWO IN AC
FEXP,	TAD I	L41
	JMS I	MODE
	TAD	C6
	DCA	FDV
	TAD I	L43	/GET OPERAND TWO
	JMS I	MODE	/WHAT IS ITS	MODE
	TAD	C3	/FLOATING POINT
	TAD	C6207	/INTEGER
	TAD	FDV
	DCA	FEX	/SAVE REOUTINE POINTER
	IAC
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
FEX,		0
	TAD I	L41	/GET OPERAND ONE
	DCA I	L43	/SAVE IN OPERAND TWO
	TAD	FEX	/GET THE OP CODE JUST PUT OUT
	TAD	CM6207	/SUBTRACT THE INTEGER TO INTEGER CASE
	SZA CLA		/WAS THIS THE INTEGER INTEGER CASE
	TAD	L50	/NO, GET A FLOATING POINT POINTER
	DCA I	L41	/AND SUBSTITUTE IT FOR OPERAND ONE
	JMS I	ARG	/PUT OUT THE PSEUDO OP ARG
	TAD I	L43	/GET THE REAL OPERAND ONE IN THE AC
	JMP I	MIRET	/JUMP TO THE RETURN ROUTINE
/COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED
EIND,	TAD	C132	/GET AN ASTERISK
	DCA	L60	/PUT IT IN SIXTY
/COMES HERE IF THE OPERATOR IS AN '='
EQU,	JMS I	CHECK	/CHECK WHATS IN THE AC
	NOP		/TWO IS IN THE AC
	JMS I	STORE	/THERES SOMETHING IN THE AC...STORE IT
	JMS I	TADDON	/NOTHING IS IN AC...ADD ONE TO IT
	TAD I	L43	/GET OPERA ND TWO
	JMS I	MODE	/WHAT IS ITS MODE
	JMP	FEQU	/ITS FLOATING POINT
	TAD	L46	/GET THE AC
	JMS I	MODE	/WHAT MODE IS IT
	JMP I	LFIX	/ITS FLOATING POINT
EFIX,	TAD	L60	/GET EQUALS INDIRECT LOCATION
	TAD	C6071	/ADD A DCA
	DCA	ASTOP	/AND SAVE OPCODE
	JMS I	PROP	/POT OUT THE OPCODE
ASTOP,		3
EQRET,	DCA	L46	/ZERO THE AC
	TAD I	L43	/GET OPERAND TWO
	JMS I	PRSYM	/PRINT IT
	JMS I	PRINT	/PUT OUT A CRLF
	DCA	L60	/ZERO SIXTY
	JMP I	.+1	/AND RETURN
	ARET
FEQU,	TAD	L46	/GET THE AC
	JMS I	MODE	/WHAT MODE IS IT
	SKP		/ITS FLOATING POINT
	JMS I	LFLOAT	/ITS INTEGER...FLOAT IT
	JMP I	.+1
	XXX

LARG,	0
	JMS I	PROP
		6201
	JMP I	LARG

TADDON,	ADDONE
E41,	41
MADDTW,	ADDTWO
FM6,	-6
C6025,	6025
MIRET,	IRET
C6,	6
C6207,	6207
LFIX,	FIX
C6071,	6071
LFLOAT,	FLOAT
CM6207,	-6207
C132,	132
	*5200
XXX,	TAD	L60	/GET THE INDIRECT EQUALS SWITCH
	SNA CLA		/IS THE SWITCH ON
	TAD	CM140	/NO, FLOATING POINT STORE
	TAD     C6146   /YES...ISTO
	DCA	FSTOP	/SAVE OPCODE
	IAC		/WE ONLY HAVE ONE ARG
	JMS I	FPROP	/PUT OUT A CALL TO A FLOATING POINT ROUTINE
FSTOP,		6146
	JMS I	ARG	/PUT OUT THE ARG PSEUDO OP
	JMP I	.+1	/JUMP BACK
	EQRET
/	THIS ADDS OPERAND ONE TO THE AC
ADDONE, 0
	TAD I	L41	/GET OPERAND ONE
	JMS I	LADDL	/PUT OUT OPCODES FOR AN ADD
	TAD I	L41	/GET FIRST OPERAND
	JMS I	PRSYM	/PUT OUT SYMBOL
	JMS I	PRINT	/PUT OUT CR LF
	TAD I	L41	/GET OPERAND ONE
	DCA	L46	/PUTN THE AC
	JMP I	ADDONE	/RETURN
UMIN,	JMS I	CHECK	/CHECK WHATSN THE AC
	NOP				/TWOSN AC
	JMS I	STORE	/THERES SOMETHINGN THE AC...STORET
	JMS	ADDONE	/NOTHINGSN AC NOW...PUT ONEN AC
	JMS I	MCOMP	/AND COMPLEMENTT
	JMP	RETURN	/AND RETURN
AADD,	JMS I	SMODE
	JMS I	CHECK	/CHECK WHATSN THE AC
	JMP	AONE	/TWOSN AC
	JMS I	STORE	/THERES SOMETHINGN THE AC...STORET
	JMS	ADDONE	/GET ONEN AC
	JMS	ADDTWO	/ONESN AC
	JMP	RETURN	/RETURN
AONE,	JMS	ADDONE	/ADD ONE TO TWO
	JMP	RETURN	/AND RETURN
LPROP,	0
	CDF 10
	TAD I	LPROP
	CDF 00
	JMS I	PRSYM	/AND PRINT THE SYMBOL
	TAD	C40	/GET A SPACE
	JMS I	PRINT	/PUT OUT
	ISZ	LPROP	/INCREMENT RETURN
	JMP I	LPROP	/AND RETURN
/	THIS ADDS OPERAND TWO TO THE AC
ADDTWO, 0
	TAD I	L43	/GET OPERAND TWO
	JMS I	LADDL	/PUT OUT OPCODES FOR AN ADD
	TAD I	L43	/GET SECOND OPERAND
	JMS I	PRSYM	/PRINT THE SYMBOL
	JMS I	PRINT	/PUT OUT CR LF
	TAD I	L43	/GET OPERAND TWO
	DCA	L46	/AND PUTN AC
	JMP I	ADDTWO	/RETURN
LXZQ,	0		/CHECK FOR EXPRESSION LEFT OF =
	CLA
	TAD	L22	/GET SUBSCRIPT NESTING DEPTH
	TAD	L44	/GET EQUALS SIGN SWITCH
	SNA CLA 	/ARE THEY BOTH ZERO
ERR42,	JMS I	LUNCH	/N	YES ...THATS AN ERROR
	JMP I	LXZQ	/RETURN
RETURN, TAD I	L41	/THISS THE RETURN...GET OPERAND ONE
	JMS I	MODE	/WHAT MODEST
	TAD	G400	/ITS FLOATING POINT...TURN F.P. BIT ON
	TAD	L40	/ADD CURRENT TRIPLE NUMBER
	DCA	L46	/PUTN AC SW
	JMP I	NARET	/AND NOW RETURN FROM THE ROUTINE
FLOAT,	0
	JMS I	FPROP	/PUT OUT A CAL TO THE FLOAT ROUTINE
		6127
	JMP I	FLOAT	/AND RETURN
FIX,	JMS I	FPROP	/PUT OUT A CAL
		6143	/TO THE FIX ROUTINE
	JMP I	.+1	/AND JUMP BACKLADDL,	ADDL
	EFIX
C6146,	6146
LADDL,	ADDL
MCOMP,	COMP
G400,	400
NARET,	ARET
LSMODE,	0
	TAD I	L43	/GET FIRST OPERAND
	JMS I	MODE	/FIND WHAT ITS MODE IS
	JMP	IBM	/ITS FLOATING POINT
	TAD I	L41	/GET OPERAND TWO
	JMS I	MODE	/THIS BETTER BE INTEGER TOO
	JMP	.+5	/ITS NOT, LUNCH
	JMP I	LSMODE	/GREAT, RETURN
IBM,	TAD I	L41	/GET OPERAND TWO
	JMS I	MODE	/THIS BETTER BE F.P. TOO
	JMP I	LSMODE	/IT IS RETURN
ERR43,	JMS I	LUNCH	/ERROR
LPUNCH,	0
	PSF		/IS PUNCH READY
	JMP	.-1	/NO, TRY AGAIN
	PLS		/YES, PUNCH THE CHARACTER
	CLA		/CLEAR THE ACCUMULATOR
	JMP I	LPUNCH	/AND RETURN
CM140,	-140

LFINI,	0		/FINAL CLEANUP AT END OF COMPILATION
	JMS I	FPROP	/PUNCH 'CALL 0,OPEN'
		OPEN
	JMS I	PROP	/PUNCH A 'PAUSE'
		6060
	JMS I	PRINT
	JMS I	PRINT	/FORCE LAST LINE OUT
	TAD	CM100
	JMS I	LEADR	/PUNCH SOME LEADER
	CDF	10
XFINI,	HLT		/JMP I LFINI, FOR DISK SYSTEM ...
	CIF	0
	JMP I	D1000	/BEGIN NEXT COMPILATION
D1000,	1000
CM100,	-100
LEADR,	LLEAD

FORST,	JMS I	PRINT	/FORTRAN STARTING POINT
	JMS I	(LIST
	DCA	.-1
	TAD	(LPUNCH
	DCA	PUNCH
	TAD	CM50
	JMS I	LEADR
	JMS I	PROP
		FORTR
	JMS I	PRINT
	JMP	START

PAGE
	*5400
LLAST,	TAD	C4000	/END OF COMPILATION, SET CHK SO THAT
	DCA	CHK	/LGTC WILL NOT READ ANOTHER LINE...
	JMS I	GNB
	SZA
	JMP I	ASSIGN
	JMS I	(OSTOP	/PUNCH A 'HLT' ETC.
	TAD	L55
	TAD	C25
	SZA CLA		/IS DO LIST EMPTY?
ERR44,	JMS I	LUNCH	/NO, COMPLAIN...
MORDUM,	TAD	L56	/GET POINTER INTO SYMBOL TABLE
	TAD 	C2	/ADD TWO TO IT FOR CONTROL BITS
	DCA	L72	/SAVE ADDRESS OF CONTROL BITS
	TAD I	L72	/GET THE CONTROL BITS
	AND	E10	/MASK ALL BUT THE DUMMY ARG BIT
	SNA CLA		/IS THE DUMMY ARG BIT ON
	JMP	LEDOUT	/NO, PUT OUT DUMMY SUBSCRIPT DEFNS
	JMS I	DEFN	/YES, PUT OUT THE VARIABLE NAME
	JMS I	PROP	/PUT OUT THE OP CODE
	6154		/WHICH IS BSS
	TAD	C2	/RESERVE TWO LOCATIONS
	JMS I	PROTAC	/PRINT THE TWO
	JMS I	PRINT
	ISZ	L56	/ADVANCE THE POINTER
	ISZ	L56
	ISZ	L56
	JMP	MORDUM	/GO BACK AND DO THE NEXT ONE
LEDOUT,	DCA	L72	/ZERO LOCATION 72
LEDOT1,	TAD	L25	/GET THE NUMBER OF SUBSCRIPT TEMPS
	CMA
	TAD	L72	/SUBTRACT FROM THE NUMBER WEVE DEFINED
	SNA CLA		/HAVE WE DEFINED THEM ALL YET
	JMP	GOOON	/YES, NOW PUT OUT THE END
	TAD	K5200	/GET SUBSCRIPT DESIGNATOR
	TAD	L72	/GET WHICH SUBSCRIPT
	JMS I	PRSYM	/AND PRINT IT
	TAD	C7240	/GET THE TERMINATOR
	JMS I	P2	/PRINT IT
	JMS I	PROP	/PRINT THE OP CODE
	6154		/WHICH IS BSS
	TAD	C2	/RESERVE TWO LOCATIONS
	JMS I	PROTAC
	JMS I	PRINT	/CRLF
	ISZ	L72	/GO ON TO THE NEXT ONE
	JMP	LEDOT1
GOOON,	JMS I	PROP
		6157	/PUT OUT AN END
	JMS I	PRINT	/PUT OUT A CRLF
	DCA	L65	/ZERO THE PSEUDO LOCATION COUNTER
	TAD	START	/CLA = -600
	JMS I	LEAD	/PUT OUT LOTS OF LEADER CODE
	JMS I	PROP
		6162	/PUT OUT A LAP
	JMS I	PRINT
SYM,	TAD	L57
	CIA
	TAD	L56
	SZA CLA 	/ARE THERE ANY SYMBOLS
	JMP	SYM1
	TAD	MIKE8
	SZA CLA		/NO, IS THERE ANY EQUIVALENCING?
	JMP I	LPTEMP
	JMP I	.+1
	PTEMP
SYM1,	TAD	L56
	TAD	C2
	DCA	L72
	TAD I	L72	/GET THE CONTROL BITS
	DCA	L72	/SAVE THEN
	TAD	L72	/GET THE BITS
	AND	E7	/MASK
	SZA CLA 	/ARE THEY FUNCT NAME,
	JMP	UP	/YES
	JMS I	DEFN	/PUT IT OUT
	TAD	L72
	AND	E20	/MASK ALL BUT THE DIMEN 
	SNA CLA		/IS EITHER ONE ON
	JMP	NORM	/NO
	TAD	L56
	JMS I	DIM
	DCA	L26
	TAD I	L14	/GET THE SECOND DIMENSION
	CIA		/AND NEGATE
	DCA	L73	/SAVE
	TAD	L26
	ISZ	L73
	JMP	.-2
ACK,	DCA	L26
	TAD	L56
	JMS I	MODE	/DETERMINE MODE OF SYMBOL
	TAD	L26
	RAL CLL
	TAD	L26
	DCA	L26
	TAD	L72
	AND	C40
	SZA CLA
	JMP	COM
	JMS I	BSS
UP,	ISZ	L56
	ISZ	L56
	ISZ	L56
	JMP	SYM
NORM,	IAC
	JMP	ACK
C25,	25
E7,	7
K5200,	5200
DEFN,	LDEFN
E20,	20
E10,	10
LPTEMP,	EEK
LEAD,	LLEAD
COM,	JMS I	PROP
		6165
	TAD	L26
	JMS I	PROTAC
	JMS I	PRINT
	JMP	UP

LCLEAR,	0		/CLEAR THE PSEUDO ACC AND MQ
	DCA	L30
	DCA	L31
	DCA	L32
	DCA	L33
	DCA	L34
	DCA	L35
	JMP I	LCLEAR
	*5600
C7600,	7600
C177,	177
LBSS,	0
	TAD	L65	/GET THE LOCATION COUNTER
	TAD	L26	/ADD THE CURRENT AMOUNT TO IT
	AND	C7600	/MASK ALL BUT THE PAGE BITS
	DCA	L64	/SAVE THE NUMBER OF PAGES
	TAD	L65	/GET THE LOCATION COUNTER AGAIN
	TAD	L26	/ADD THE CURRENT DISPLACEMENT AGAIN
	AND	C177	/NOW GET THE NUMBER OF LOCATIONS OVER A PAGE
	DCA	L65	/AND SAVE
L,	TAD	L64	/GET THE NUMBER OF PAGES TO BE RESERVED
	SNA		/ARE THERE ANY TO BE RESERVED
	JMP	CRAM	/NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS
	TAD	C7600	/YES...SUBTRACT ONE FROM THE PAGE COUNT
	DCA	L64	/AND SAVE IT
	TAD	L65	/GET THE NUMBER OF EXTRA LOCATIONS
	DCA	L26	/AND PUT IN THE DISPLACEMENT LOCATION
	JMS I	PROTAC	/PUT OUT A ZERO
	JMS I	PRINT	/PUT OUT A CRLF
	JMS I	PROP	/PUT OUT THE OPCODE
		6151	/WHICH IS THE PAGE PSEUDO OP
	JMS I	PRINT	/PUT OUT A CRLF
	JMP	L	/NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES
CRAM,	JMS I	PROP	/NOW PUNCH 'BLOCK <N>'
		BLCK
	TAD	L26
	JMS I	PROTAC
	JMS I	PRINT
	JMP I	LBSS
LDEFN,	0
	TAD	L56	/GET THE POINTER TO THE SYMBOL
	JMS I	PRSYM	/PRINT THE SYMBOL
	TAD	C7240	/GET THE TERMINATOR
	JMS I	P2	/PRINT IT
	JMP I	LDEFN	/AND RETURN
AFCON,	TAD	L47	/GET START OF FCON TABLE
	TAD	C3	/UPDATE IT
	DCA	L56	/SAVE UPDATED ADDRESS
FLOOP,	TAD	L50	/GET END OF FCON TABLE
	CIA
	TAD	L56	/SUBTRACT FROM CURRENT POINTER
	SNA CLA		/ARE WE DONE
	JMP	ALTHRU	/YES
	TAD	CM3	/NO, GET MINUS THREE
	DCA	L63	/TO USE AS A COUNTER
	JMS	LDEFN	/DEFINE IT
	TAD I	L56	/GET THE FIRST WORD
	ISZ	L56	/ADVANCE THE POINTER TO THE NEXT WORD
	JMS I	PROTAC	/PRINT THE WORD
	JMS I	PRINT	/PUT OUT A CRLF
	ISZ	L63	/HAVE WE PUT OUT ALL THREE WORDS
	JMP	.-5	/NO...PUT OUT ANOTHER
	JMP	FLOOP	/YES...GET THE NEXT CONSTANT
PTEMP,	TAD	K561
	DCA	L56
FTLOOP, TAD	L45
	CMA
	TAD	L56
	SNA CLA
	JMP	ITEMP
	TAD	C3
	DCA	L26
	TAD	K5400	/GET F.P. DESIGNATOR
	JMS	LDEFN	/PRINT THE SYMBOL
	JMS I	BSS	/RESERVE THE LOCATIONS FOR IT
	ISZ	L56	/INCREMENT THE POINTER
	JMP	FTLOOP
ITEMP,	TAD	K531
	DCA	L56
ILOOP,	TAD	L51
	CMA
	TAD	L56
	SNA CLA
	JMP	SUBOUT
	IAC
	DCA	L26
	TAD	K5000	/GET THE INTEGER TEMP DESIGNATOR
	JMS	LDEFN	/PRINT IT
	JMS I	BSS	/RESERVE LOCATIONS FOR IT
	ISZ	L56	/INCREMENT THE POINTER
	JMP	ILOOP
ALTHRU,	TAD	D6	/PUNCH AN 'IFF 6'
	JMS I	PIFF	/SO THAT ENTRY WILL NOT BE AT END OF THE PAGE
	JMS I	PROP
		6055	/PUT OUT AN EAP
	JMS I	PRINT
	TAD	L70	/GET THE SUBROUTINE FUNCTION POINTER
	SZA CLA 	/IS IT ZERO
	JMP	THRU	/NO...WE MUST BE IN A SUBR OR A FUNC
	JMS I	PROP	/YES ...WERE IN A MAIN PROGRAM
		6052	/PUT OUT ENT
	TAD	C6000	/POINTER TO THE SYMBOL MAIN
	JMS I	PRSYM	/PRINT THE SYMBOL
	JMS I	PRINT	/PUT OUT A CRLF
	TAD	C6000	/GET THE POINTER TO MAIN AGAIN
	JMS I	PRSYM	/PRINT	IT
	TAD	C7240	/GET A COLON
	JMS I	P2	/PRINT THEM
	JMS I	PROP
		6047
	JMS I	PRINT	/PUT OUT A CRLF
THRU,	JMS I	FINI
	6201		/CDF FIELD 0
	JMP I	C7600	/AND RETURN TO THE MONITOR ...
C6000,	6000
SUBOUT,	DCA	L56
SUBOT1,	TAD	L25
	CMA
	TAD	L56
	SNA CLA
	JMP	AFCON
	JMS I	PROP	/PUT OUT THE OP CODE
	6176		/WHICH IS DUMMY
	TAD	X5200	/GET SUBSCRIPT DESIGNATOR
	TAD	L56	/GET THE POINTER 
	JMS I	PRSYM	/PRINT THE SYMBOL
	JMS I	PRINT	/CRLF
	ISZ	L56
	JMP	SUBOT1
K5000,	5000-ITTAB
K5400,	5400-FTTAB
K531,	ITTAB+1
K561,	FTTAB+1
X5200,	5200
FINI,	LFINI
D6,	6
	*6000
/FUNCTION AND SUBROUTINE STATEMENT PROCESSOR
LFUNC,	JMS I	LOOK	/CHECK REST OF STATEMENT
MFOUR,		-4	/
		-24	/T
		-11	/I
		-17	/O
		-16	/N
	CLA IAC 	/SET SWITCH
	JMP	TART
LSUB,	JMS I	LOOK	/CHECK REST OF STATEMENT
		-6	/
		-17	/O
		-25	/U
		-24	/T
		-11	/I
		-16	/N
		-5	/E
TART,	DCA	L67	/THIS IS THE SWITCH
	JMS	SUBB
	CLA CMA
	TAD	C6275	/THIS IS THE PLACE TO STORE FUNCTION NAME
	DCA	L11	/USE AUTO INDEXING TO STORE THE NAME
	TAD	L30	/GET THE FIRST WORD
	DCA I	L11	/PUT IT IN THE SYMBOL TABLE
	TAD	L31	/GET THE SECOND WORD
	DCA I	L11	/PUT IT IN THE TABLE
	TAD	L32	/GET THE THIRD WORD
	IAC		/TURN THE EXTERNAL SYMBOL BIT ON
	DCA I	L11	/AND PUT IT IN THE TABLE
	TAD	C6275	/GET THE POINTER
	DCA	L70	/AND PUT IT IN LOC 70
	JMS I	PROP
		6052	/PUT OUT AN ENT
	TAD	L70	/GET THE SUBROUTINE NAME
	JMS I	PRSYM	/PRINT IT
	JMS I	PRINT	/PUT OUT A CRLF
	CLA CMA
	DCA	READY	/SET SWITCH
	TAD	L70	/GET THE SUB NAME
	JMS I	PRSYM	/PUT IT OUT
	TAD	C7240
	JMS I	P2	/PUT IT OUT
	JMS I	PROP	/PUT OUT THE OP CODE 'BLOCK 2'
		BLCK
	TAD	C2
	JMS I	PROTAC
	JMS I	PRINT
	DCA	WHICH	/ZERO THE SWITCH WHICH TELLS WHICH WORD
MORE,	JMS I	GNB
	SNA		/CHECK FOR END OF CARD
	JMP	CKCR
	TAD	CM50	/CHECK FOR LEFT PAREN
	SNA		/IS IT A LPAR
	JMP	GET1	/YES
	TAD	MFOUR
	SNA		/IS IT A COMMA
	JMP	XGET	/YES
	TAD	C3
	SNA CLA 	/IS IT A LPAR
	JMP	START	/YES
	JMP	ERR48	/NO
GET1,	ISZ	READY	/WERE WE READY FOR LPAR
	JMP	ERR48	/NO, ERROR ...
XGET,	JMS	SUBB
	TAD	L32
	TAD	TEN
	DCA	L32
	TAD	C77	/GET MASK FOR SYMBOL TABLE
	DCA	L21	/AND PUT INTO THE SWITCH
	JMS I	SYMTAB	/AND PUT IN SYMBOL TABLE
	JMS I	PROP
		DUMMY
	TAD	L77
	JMS I	PRSYM
	JMS I	PRINT
DLOOP,	JMS I	PROP
		6063	/PUT OUT A TAD*
	TAD	L70	/GET THE FUNCTION NAME
	JMS I	PRSYM	/AND PRINT IT
	JMS I	PRINT	/PUT OUT A CRLF
	JMS I	PROP
		6071	/PUT OUT A DCA
	TAD	L77	/GET ADDRESS OF SYMBOL
	JMS I	PRSYM	/PRINT IT
	TAD	WHICH	/GET THE WHICH SWITCH
	RAR		/GET THE LOW BIT INTO THE LINK
	SNL CLA 	/IS THE WHICH SWITCH BIT SWITCHED
	JMP	NEXT	/NO...THAT MEANS WERE ON THE FIRST WORD
	TAD	E43	/YES...WERE ON SECOND WORD...GET A "#"
	JMS I	PRINT	/PRINT IT
NEXT,	JMS I	PRINT
	JMS I	PROP	/PUT OUT AN INC (ISZ WHICH DOES NOT SKIP)
		6237
	TAD	L70	/GET THE FUNCTION NAME
	JMS I	PRSYM	/AND PRINT IT
	TAD	E43
	JMS I	PRINT
	JMS I	PRINT	/PUT OUT A CRLF
	ISZ	WHICH	/INCREMENT THE SHICH SWITCH
	TAD	WHICH	/GET THE SWITCH
	RAR		/GET LOW BIT IN THE LINK
	SZL CLA 	/IS THE LOW BIT ON
	JMP	DLOOP	/YES...WORK ON THE SECOND WORD
	JMP	MORE	/GO GET SOME MORE
READY,	0
SUBB,	0
	JMS I	ENTITY
	SKP
	JMP I	SUBB
E43,	43
TEN,	10
	JMP	ERR48
WHICH,	0
C6275,	6275		/SUBROUTINE OR FUNCTION NAME POINTER
CKCR,	ISZ	READY
ERR48,	JMS I	LUNCH
	JMP	START

IOEQL,	CLA CMA		/ROUTINE TO TERMINATE IMPLIED DO LOOPS
	TAD	IMPDO
	DCA	IMPDO	/REDUCE THE DEPTH BY 1
	JMS I	DONEXT	/GENERATE END-OF-LOOP CODE
	JMS I	GNB
	TAD	CM51
	SZA CLA		/SKIP TO A RIGHT PAREN
	JMP	.-3
	JMP I	.+1
	IOH0
DONEXT,	LDNEXT
	*6200
LWRIT,	JMS I	LOOK	/LOOK FOR REST OF STATEMENT
		-1
		-5
	TAD	C3
LREAD,	TAD	C6030	/GET THE POINTER TO READ AND WRITE
	DCA	IOP	/USE AS A PARAMETER WITH FPROP
	JMS  I	GNB
	TAD	CM50
	SZA CLA		/IS THIS A LEFT PAREN?
	JMP I	ASSIGN
	JMS	SUBA
	JMS I	ZZZ
	TAD	C2
	JMS I	FPROP
IOP,	0
	JMS I	ARG
	TAD	L32
	JMS I	PRSYM
	JMS I	PRINT
	JMS I	ARG
	JMS I	GNB
	TAD	CM54	/IS IT A COMMA
	SZA CLA
	JMP	ERR50	/NO, ERROR ...
	JMS	SUBA
	TAD	L32	/GET FORMAT
	JMS I	PLAB
	JMS I	GNB
	TAD	CM51	/CHECK FOR A RIGHT PAREN
	SZA CLA 	/IS IT?
ERR50,	JMS I	LUNCH
	JMS I	PRINT
IOH0,	JMS I	GNB
	SNA
	JMP	IOH2
	TAD	CM54
	SNA CLA 	/IS IT A COMMA
	JMP	IOH3	/YES ...
IOH1,	JMS I	PUTCH	/NO...PUT IT BACK
	JMS I	GNB	/THIS STMT IS TRANSFERRED TO!
	TAD	CM50
	SNA CLA
	JMP I	IOPEN	/OPEN PAREN - MAY BE IMPLIED DO-LOOP
IOH1BK,	JMS I	PUTCH
	DCA	L52	/SET SWITCHES FOR GENER
	DCA	L46
	ISZ	L44
	JMS I	GENER	/START PROCESSING THE IO LIST
	TAD	L41
	DCA	L42
	TAD	L53
	DCA	L73	/SAVE CREATED LABEL LOC
	DCA	L23	/ZERO TEMPORARY FOR "DUMARG"
	JMS I	LCHNG	/TEST FOR 0 OR DUMMY ARG
	DCA I	L41
	TAD	L23	/GET TEMPORARY FROM "DUMARG"
	SZA CLA		/ZERO MEANS NON-VARIABLE NAME
	TAD I	L23	/NON-ZERO POINTS TO FLAG WORD OF VAR
	AND	Q20
	SNA CLA		/DO WE HAVE AN ARRAY NAME?
	JMP	NOSYMB	/NO
	JMS I	PROP
	OPCMA		/PUT OUT A "CMA" TO DISTINGUISH THIS CALL
	JMS I	PRINT	/FROM A REGULAR CALL TO "IOH"
	TAD	C2
	JMS I	FPROP
	6036		/OUTPUT A "CALL 2,IOH"
	JMS I	ARG
	TAD	L23
	TAD	CM2
	JMS I	DIM	/GET THE DIMENSIONS
	DCA	IOP
	TAD I	L14
	CIA
	DCA	L44
	TAD	L23
	TAD	CM2
	JMS I	MODE	/GET THE MODE OF THE ARRAY
	TAD	C4000	/FLOATING POINT - ADD 4000 TO AC
	TAD	IOP
	ISZ	L44
	JMP	.-2	/COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT
	JMS I	PROTAC	/PRINT IT
	JMS I	PRINT
	JMP	IOHRSM	/GO PRINT ARRAY NAME
NOSYMB,	TAD	L46
	SZA CLA
	JMS I	STORE
	IAC		/THERE WILL BE ONE ARGUMENT
	JMS I	FPROP	/PUT OUT THE CALL TO IOH
		6036
IOHRSM,	TAD	L73
	DCA	L53	/RESTORE CREATED LABEL LOC
	TAD I	L41
	JMS I	QSYMOT
	TAD	L63	/GET TERMINATING CHAR
	SNA CLA		/WAS IT A <CR>?
	JMP	IOH2	/YES
IOH3,	JMS I	GNB	/GENTLY LOOK AHEAD ...
	SNA CLA		/DO WE HAVE A ',<CR>' ?
	JMP	START	/YES, DO NOT TERMINATE YET ...
	JMP	IOH1	/NO, PUSH IT BACK & PROCESS NEXT ITEM
IOH2,	IAC		/THERE WILL BE ONE ARGUMENT
	JMS I	FPROP	/PUT OUT A CALL TO IOH
		6036
	JMS I	ARG	/PUT OUT THE PSEUDO OP ARG
	JMS I	PROTAC
	JMS I	PRINT
	JMP	START
SUBA,	0
	JMS I	ENTITY
	JMP ERR51	/ITS A CR
	JMP ERR51+1	/ITS A VARIABLE
	JMP I	SUBA
Q20,	20
ERR51,	JMS I	LUNCH
	DCA	L21	/ZERO THE SYMBOL TABLE SWITCH
	JMS I 	SYMTAB
	TAD	L77
	JMS I	MODE
	JMP	ERR51
	TAD	L77
	DCA	L32
	JMP I	SUBA
IOPEN,	IOOPEN
QSYMOT,	SYMOUT
C6030,	6030
		*6400
LRET,	JMS I	LOOK	/CHECK REST OF STATEMENT
		-2
		-22
		-16
	JMS I	ZZZ
	TAD	L70
	SNA CLA		/ARE WE COMPILING MAIN PROGRAM?
ERR60,	JMS I	LUNCH	/YES
	TAD	L67
	SNA CLA
	JMP	INT	/ITS A SUBROUTINE
	TAD	L70	/GET HE NAME OF THE FUNCTION
	JMS I	MODE	/IS IT FP OR INTEGER
	JMP	.+4	/ITS FP
	JMS I	PROP
		6066	/OPCODE IS TAD
	JMP	.+5	/PUT OUT THE SYMBOL
	IAC		/THERE IS ONE ARGUMENT
	JMS I	FPROP
		6003
	JMS I	ARG
	TAD	F34	/GET A BACK SLASH
	JMS I	PRINT
	TAD	L70	/GET THE NAME OF THE FUNCTION
	JMS I	PRSYM	/PRINT THE NAME
	JMS I	PRINT	/PUT OUT A CRLF
INT,	JMS I	PROP
		6077	/OPCODE IS RTN
	TAD	L70	/GET THE FUNCTION NAME
	JMS I	PRSYM	/PRINT IT
	JMS I	PRINT	/PUT OUT A CRLF
	JMP	START	/WERE DONE

LGETHI,	0		/PUNCH 'TAD ACH'
	JMS I	PROP
		6066
	JMS I	PROP	/PRINT THE OP CODE
	6226		/WHICH IS ACH (HIGH ORDER AC)
	JMS I	PRINT
	JMS I	FPROP	/PUNCH 'CALL 0,CLEAR'
		6204
	JMP I	LGETHI
LDIM,	0		/GETS THE 1ST DIMENSION OF THIS VARIABLE
	DCA	LGETHI	/SYMBOL TABLE ADDRESS IS IN THE AC
	CMA
	TAD	L50
	DCA	L14
LK,	TAD I	L14	/SEARCH THE DIMENSION TABLE
	CIA
	TAD	LGETHI
	SNA CLA
	JMP	.+4
	ISZ	L14
	ISZ	L14
	JMP	LK
	TAD I	L14	/EXIT WITH DIMENSION IN THE AC
	JMP I	LDIM
/	THIS PROCESSES SUBSCRIPTS
SUBRET,	JMP I	LSUBSC	/RETURN FROM SUBSC
LSBTEM,	0		/THIS ROUTINE MAKES AN ENTRY
	DCA	TRIP	/IN SUBSCRIPT TEMPORARY TABLE
	TAD	FBASE
	DCA	POINT
	TAD	CM40
	DCA	PCTR
LOOP,	TAD I	POINT	/LOOK FOR CURRENT TRIPLE NR
	SNA		/OR END OF TABLE...
	JMP	YES
	CIA
	TAD	TRIP
	SNA CLA
	JMP	GOT
	ISZ	POINT
	ISZ	PCTR
	JMP	LOOP
ERR53,	JMS I	LUNCH
YES,	TAD	TRIP
	DCA I	POINT
GOT,	TAD	FBASE
	CIA
	TAD	POINT
	DCA	POINT
	TAD	POINT
	CIA
	TAD	L25
	SPA CLA		/IF TEMPORARY NR > L25
	ISZ	L25	/BUMP L25
	TAD	POINT
	JMP I	LSBTEM
LWIPE,	0		/ZERO THE SUBSCRIPT TEMP. TABLE
	TAD	FBASE
	DCA	POINT
	TAD	CM40
	DCA	PCTR
LOOP2,	DCA I	POINT
	ISZ	POINT
	ISZ	PCTR
	JMP	LOOP2
	JMP I	LWIPE
LZER,	0
	ISZ	LZER	/INCREMANT
	JMS I	PROTAC	/PUT OUT A ZERO
	JMP I	LZER	/AND REUTURN
LCLAB,	0
	SNA	/IF NO LABEL IN AC,
	JMS I	CREATE	/CREATE A LABEL
	JMS I	PRCRL	/AND PRINT IT
	TAD	C7240	/PUT OUT A COLON AND SPACE
	JMS I	P2
	JMP I	LCLAB	/RETURN
FBASE,	4600
POINT,	0
PCTR,	0
TRIP,	0
F34,	34
LSUBSC,	0
	TAD	L46
	SZA		/IS THERE ANYTHING IN THE AC?
CHANGE,	SKP CLA		/********************************
/		TRY CHANGING THIS LOCATION TO A "JMS I MODE"
/		TO LIMIT THE CHECK TO THE INTEGER AC!
/		COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P.
/		EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS)
	SKP		/NOTHING IN THE AC
	JMS I	STORE	/YES - STORE IT
	IAC
	DCA	L63
	TAD	L53
	DCA	L73
	TAD	L41
	DCA	L42
	ISZ	L41
	TAD I	L41
	TAD	CM4046
	SNA CLA		/WAS IT A PRIME
	JMP	BACK
	JMS I	LCHNG
	DCA	L63
	ISZ	L41
	ISZ	L41
	ISZ	L42
	ISZ	L42
	IAC
BACK,	ISZ	L41
	DCA	SYMOUT
	JMS	CHNG
	DCA	L65
	ISZ	L42
	ISZ	L42
	JMS	CHNG
	DCA	LDUM	/SAVE ARRAY POINTER (OR 0 IF DUMMY)
	TAD	L73	/NOW RESTORE THE CREATED LABEL LOC
	DCA	L53
	TAD	SYMOUT
	SNA CLA		/HOW MANY SUBSCRIPTS?
	JMP	.+7	/ONE - SKIP OUTPUTTING "TAD"
	JMS I	PROP
		6066
	TAD I	L41
	JMS I	DIM
	JMS I	PRSYM
	JMS I	PRINT
	TAD I	L41
	JMS I	MODE
	JMP	FP
CASUB,	TAD	H200
	TAD	L40
	DCA I	L41	/STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK
	TAD	SYMOUT	/GET NUMBER OF ARGUMENTS (2 OR 3)
	TAD	C2
	JMS I	FPROP	/PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE
		6173	/TO THE SUBSCRIPTING ROUTINE
	TAD	SYMOUT
	SNA CLA		/ONLY ONE ARG?
	JMP	.+3	/YES - DON'T OUTPUT FIRST SUBSCRIPT
	TAD	L63
	JMS	SYMOUT
	TAD	L65
	JMS	SYMOUT
	TAD	LDUM	/GET THE ARRAY NAME
	JMS	SYMOUT	/OUTPUT IT AS AN ARGUMENT
	TAD I	L41
	JMS I	PRSYM	/OUTPUT THE DESTINATION TEMPORARY
	JMS I	PRINT
	TAD I	L41
	DCA	L12	/MARK IT AS THE CONTENTS OF THE LAST LINE
	JMP I	FSUBSC	/RETURN
FP,	JMS I	PROP
		OPCMA			/OPCODE IS CMA
	JMS I	PRINT
	TAD	H400	/SET MODE TO FLOATING POINT
	JMP	CASUB
SYMOUT, 0
	DCA	CHNG
	TAD	CHNG
	SNA CLA
	JMS I	CLAB	/CREATE LABEL IF DUMMY ARG
	JMS I	ARG
	TAD	CHNG
	SNA		/IS IT ZERO
	JMS I	ZER	/YES PUT OUT A ZERO
	JMS I	PRSYM	/OTHERWISE PUT OUT SUBSCRIPT
	JMS I	PRINT	/PUT OUT A CRLF
	JMP I	SYMOUT

LDSPCL,	DCA	L24
	JMS I	CREATE
	JMS I	PRCRL	/CHANGE LAST LINE TO STORE IN NEW DESTINATION
	DCA	L12	/MARK LAST LINE USELESS FOR OPTOMIZATION
	JMP	LDMRET
LDUM,	0
	ISZ	LDUM	/INCREMENT RETURN
	TAD I	L42	/GET THE THING WHICH IS DUMMY
	CIA
	TAD	L12	/DID WE JUST PUT THIS OUT AS A SUBSCRIPT
	SNA CLA		/DESTINATION??
	JMP	LDSPCL	/YES - SAVE OODLES OF CODE
	JMS I	PROP
		6066	/PUT OUT A TAD
	TAD I	L42
	JMS I	PRSYM	/PUT IT OUT
	JMS I	PRINT	/PUT OUT A CRLF
	JMS I	PROP
		6071	/PUT OUT A DCA
	JMS I	CREATE	/CREATE A LABEL
	JMS I	PRCRL	/AND PRINT IT
	JMS I	PRINT	/PUT OUT A CRLF
	JMS I	PROP
		6066
	TAD I	L42
	JMS I	PRSYM
	TAD	H43
	JMS I	PRINT
	JMS I	PRINT
	JMS I	PROP
		6071
	TAD	L53
	JMS I	PRCRL
	TAD	H43
	JMS I	PRINT
LDMRET,	JMS I	PRINT
	JMP I	LDUM	/RETURN
CHNG,	0
	TAD I	L42	/NO...THERES TWO SUBSCRIPTS
	SNA
	TAD	H6041
	DCA I	L42
	TAD I	L42
	JMS I	DUMARG	/SEE IF SECOND SUBSC IS A DUMMY ARG
	JMS I	DUM	/YES IT IS A DUMMY ARG
	TAD I	L42	/GET THE SECOND SUBSC
	JMP I	CHNG

H400,	400
H200,	200
H43,	43
FSUBSC,	SUBRET
H6041,	6041
	*7000
IOHTMP,MCHAR,	0
NPOINT,LLUNCH,	0
	CLA
	DCA	L75
	DCA	L24	/ZERO "BUFFER WAITING TO PRINT" FLAG
	DCA	IMPDO	/ZERO IMPLIED DO LOOP FLAG
	TAD	TTYPE	/CHANGE TO TTY OUTPUT
	DCA	PUNCH
	JMS I	LLIST	/TYPE THE CURRENT LINE
	TAD	KOUNT	/USE THE BUFFER POINTER AS AN INDEX
	CIA
	IAC
	DCA	L7
	TAD	C40	/NOW PUT OUT SOME SPACES...
	JMS I	PRINT
	ISZ	L7
	JMP	.-3
	TAD	D36	/AND AN '^'
	JMS I	PRINT
	JMS I	PRINT
	TAD	LELIST	/NOW TYPE THE ERROR MESSAGE
	DCA	L10
UNCH1,	TAD I	L10
	SZA		/END OF TABLE?
	TAD	LLUNCH
	SNA CLA		/IS THIS THE MSG WE WANT?
	JMP	UNCH2
	ISZ	L10	/NO
	JMP	UNCH1
UNCH2,	TAD	BASE
	CIA
	TAD I	L10
	JMS I	LLIST	/FAKE LISTER INTO PRINTING ERROR MESG
	JMS I	PRINT	/FORCE BUFFER
	TAD	EPNCH	/BACK TO PUNCH OUTPUT
	DCA	PUNCH
	ISZ	L75	/SET THE NON-PRINT SWITCH
	JMP	START	/GO PROCESS THE NEXT STATEMENT
LLIST,	LIST
D36,	36
LELIST,	ELIST-1		/ERROR LIST ...
TTYPE,	LTTYPE
EPNCH,	LPUNCH
CTR,	0
TEM,	0
/	THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL
PARCT,LDCOUT, 0
	DCA	TEM	/SAVE THE AC
	TAD	CM3	/WE WILL PUT OUT FOUR CHARACTERS
	DCA	CTR
	TAD	ASE	/THIS IS THE ASE OF THE CONVERSION TABLE
	DCA	NPOINT	/SAVE IT IN THE POINTER
	DCA	FLAG
LOP,	DCA	MCHAR	/ZERO OUT THE CHARACTER
	TAD	TEM	/GET THE NUMBER AGAIN
	TAD I	NPOINT	/TO GET THE ITEM IN THE TABLE
	SPA		/IS THE RESULT POSITIVE
	JMP	LOPRST	/NO...RESTORE THE NUMBER
	DCA	TEM	/AND SAVE THIS VALUE
	TAD	D60
	DCA	FLAG	/SET FLAG TO SHOW THAT WE HAVE SOMETHING
	ISZ	MCHAR	/YES...INCREMENT THE OUTPUT CHARACTER
	JMP	LOP+1	/TRY THE SEQUENCE AGAIN
LOPRST,	CLA
	TAD	MCHAR
	TAD	FLAG
	SZA		/DO WE HAVE A SIGNIFICANT DIGIT?
	JMS I	PRINT	/YES - PRINT IT
	ISZ	NPOINT
	ISZ	CTR
	JMP	LOP	/AND GET THE NEXT DIGIT
	TAD	TEM	/GET THE CHARACTER TO OUTPUT
	TAD	D60	/PUT IT IN TRIMMED ASCII FORM
	JMS I	PRINT	/PRINT IT
	JMP I	LDCOUT	/YES...RETURN TO CALLING PROGRAM
ASE,	THOU
FLAG,	0

/ TELETYPE OUTPUT TOUTINE FOR ERROR MESSAGES
LTTYPE,	0
	TSF
	JMP	.-1
	TLS
	CLA
	JMP I	LTTYPE

IOOPEN,	TAD	KOUNT
	DCA	IOHTMP	/SAVE POINTER TO LEFT PAREN +1
	CLA CMA
	DCA	PARCT	/INITIALIZE PAREN COUNTER
	TAD	KOUNT
	DCA	TEM	/TEM POINTS TO ENTITY  (OR PREV ONE IF A VAR)
IOPENL,	JMS I	ENTITY	/GET SOMETHING
ERR52,	JMS I	LUNCH	/END OF STMT - BAD
	JMP	IOPENL	/VARIABLE - DON'T UPDATE TEM
D60,	60
	JMP	IOPENL-2	/CONSTANT - UPDATE TEM
	TAD	CM51	/PUNCTUATION - TEST FOR RIGHT PAREN
	SNA
	JMP	IORPAR	/YES
	IAC
	SNA		/LEFT PAREN?
	JMP	IOLPAR
	TAD	CM25
	SNA CLA		/IF CHAR IS AN EQUAL SIGL
	TAD	PARCT
	IAC
	SZA CLA		/AND WE ARE ON THE TOP LEVEL OF PARENTHESES
	JMP	IOPENL-2
	TAD	TEM	/THEN WE HAVE AN IMPLIED DO
	DCA	KOUNT
	JMS I	DO	/GENERATE DO LOOP CODE
	JMP	ERR52	/NOT TERMINATED WITH RPAR - ERROR
	ISZ	IMPDO	/BUMP IMPLIED DO COUNT
	TAD	IOHTMP
	DCA	KOUNT	/RESTORE CHAR PTR TO BEGINNING OF LOOP
	JMP I	.+1
	IOH1+1		/COMPILE INNARDS OF LOOP

IOLPAR,	CLA CMA
	TAD	PARCT
	JMP	IOPENL-3	/BUMP PAREN COUNT  UP AND LOOP

IORPAR,	ISZ	PARCT	/BUMP PAREN COUNT DOWN
	JMP	IOPENL-2	/LOOP IF NOT BALANCED
	TAD	IOHTMP
	DCA	KOUNT	/BALANCED - NOT AN IMPLIED DO
	JMP I	.+1
	IOH1BK		/COMPILE NORMALLY
CM25,	-25
DO,	XDO
	*7200
EQUI,	JMS I	LOOK	/CHECK REST OF STATEMENT TYPE
	-7	/THERE ARE 7 MORE CHARACTERS
	-26	/V
	-1	/-A
	-14	/-L
	-5	/-E
	-16	/-N
	-3	/-C
	-5	/-E
RETA,	ISZ	SNUM	/INCREMENT THE STRING NUMBER
	JMS	CCCC	/GET AND CHECK THE NEXT NON-BLANK CHARACTER
	SKP		/ONLY LEGAL CHAR HERE IS A "("
	JMP	RETB	/WE GOT THE "("
	NOP
	JMP	ERR59
RETB,	JMS I	ENTITY	/LOOK FOR A VARIABLE
	SKP
	JMP	LA	/GOT IT, ANYTHING ELSE IS AN ERROR
	NOP
	NOP
	JMP	ERR59
LA,	ISZ	L32	/TURN EQUIVALENCE BIT ON
	ISZ	L32
	TAD	K57	/GET MASK FOR SYMBOL TABLE
	DCA	L21	/PUT IN THE SYMBOL TABLE SWITCH
	JMS I	SYMTAB	/PUT IN SYMBOL TABLE
	TAD	L77	/GET THE POINTER
	ISZ	MIKE4	/AND PUT IN EQUIVALENCE TABLE
	DCA I	MIKE4
	TAD	SNUM	/GET THE CURRENT STRING NUMBER
	ISZ	MIKE4	/AND PUT IT IN THE EQUIVALENCE TABLE
	DCA I	MIKE4
	ISZ	MIKE8	/INCREMENT NUMBER OF ENTRIES
	JMS	CCCC	/GET NEXT PUNCTUATION
	JMP	ERR59	/C/R, THAT'S AN ERROR ...
	JMP	.+3	/LEFT PAREN, VARIABLE IS SUBSCRIPTED
	JMP	LB	/COMMA, NOT SUBSCRIPTED, STRING CONTINUES
	JMP	LC	/RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING
	JMS I	ENTITY	/LOOK FOR SUBSCRIPT
	NOP
	SKP
	JMP	LD	/GOT IT, ANYTHING ELSE IS ERROR
	NOP
	JMP	ERR59
LD,	CLA CMA	/SUBTRACT ONE FROM
	TAD	L32	/FIRST SUBSCRIPT
	DCA	INTA	/AND SAVE
	JMS	CCCC	/GET NEXT PUNCTUATION
	NOP		/CR IS ILLEGAL HERE
	JMP	RETB-1	/SO IS LEFT PAREN
	SKP		/COMMA, DOUBLY SUBSCRIPTED
	JMP	LF	/RIGHT PAREN, SINGLY SUBSCRIPTED
	JMS I	ENTITY	/GET OTHER SUBSCRIPT
	NOP
	SKP
	JMP	LG	/GOT IT
	NOP
	JMP	LD-1
LG,	TAD	L32	/SET IT NEGATIVE
	CIA
	DCA	INTB	/AND SAVE IT
	JMS	CCCC	/GET NEXT PUNCTUATION
	NOP
	NOP
ERR59,	JMS I	LUNCH
	TAD	L77	/RIGHT PAREN IS ONLY LEGAL CHARACTER
	JMS I	DIM	/GET DIMENSION INFORMATION
	DCA	CCCC	/AND SAVE
	SKP		/GO TO TEST PART OF LOOP
	TAD	CCCC	/THIS LOOP IS A MAKESHIFT MULTIPLY
	ISZ	INTB	/ARE WE DONE
	JMP	.-2	/NO
	TAD	INTA	/YES, ADD FIRST SUBSCRIPT
	DCA	INTA	/AND SAVE
LF,	TAD	L77	/GET POINTER TO VARIABLE
	JMS I	MODE	/WHAT MODE IS IT
	TAD	INTA	/F.P., MULTIPLY BY THREE
	RAL CLL	/INTEGER
	TAD	INTA
	IAC		/ADD ONE TO ANSWER
	ISZ	MIKE4	/AND PUT IN EQUIVALENCE TABLE
	DCA I	MIKE4
	JMS	CCCC	/GET NEXT PUNCTUATION
	NOP
	JMP	RETB-1	/CR AND "(" ARE ILLEGAL HERE
	JMP	RETB	/COMMA MEANS STRING NOT FINISHED
	JMP	LI	/")" MEANS STRING FINISHED
LC,	CLA IAC	/HERE WE CRAM A ONE INTO EQUIVALENCE
	ISZ	MIKE4
	DCA I	MIKE4
LI,	JMS	CCCC	/WE FINISHED A STRING, ARE THERE MORE
	JMP	START	/NO
	SKP
	JMP	RETA	/YES
	JMP	RETB-1	/"(" AND ")" ARE ILLEGAL HERE
LB,	CLA IAC		/CRAM A ONE INTO TABLE
	ISZ	MIKE4
	DCA I	MIKE4
	JMP	RETB	/AND GO BACK
/
/	THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR
/
CCCC,	0
	JMS I	GNB
	SNA		/PUNCTUATION IS WHAT WE WANT
	JMP I	CCCC	/ITS A CR
	TAD	CM54
	SNA		/IS IT A COMMA
	JMP	XCOMMA	/YES
	TAD	C3
	SNA		/IS IT A ")"
	JMP	XRPAR	/YES
	IAC
	SNA		/IS IT A "("
	JMP	XLPAR	/YES
	JMP	RETB-1	/NONE OF THE ABOVE
XRPAR,	ISZ	CCCC
XCOMMA,	ISZ	CCCC
XLPAR,	ISZ	CCCC
	JMP I	CCCC
K57,	57

LFIN,	JMS I	GNB
	SZA CLA
	JMP I	ASSIGN
	JMS I	ZZZ	/PRINT LABEL ON "FINI"
	JMP I	.+1
	IOH2

/THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE
/AT THE END OF A COMPILATION
	*7376
EEK,	ISZ	MIKE4
	ISZ	MIKE4
	DCA I	MIKE4	/SET END OF LIST
	JMS	INIT	/INITIALIZE POINTERS
AAB,	TAD	MA	/SET POINTERS TO STRING NUMBERS
	TAD	C3
	DCA	MB
	ISZ	MA
	ISZ	MA
AAC,	ISZ	MB
AA,	ISZ	MB
	TAD I	MA	/GET FIRST STRING NUMBER
	CIA
	TAD I	MB	/SUBTRACT FROM SECOND
	SZA CLA		/ARE THEY THE SAME
	JMP	KICK1	/NO, ADVANCE POINTERS
	ISZ	MA	/YES, MOVE TO LINEAR SUBSCRIPT
	ISZ	MB
	TAD I	MA	/GET FIRST SUBSC
	CIA
	TAD I	MB	/SUBTRACT FROM SECOND
	SPA CLA SNA	/IS FIRST ONE SMALLER
	JMP	KICK2	/NO, JUST ADVANCE POINTERS
	TAD	MA	/YES, SWITCH PLACES
	TAD	CM2
	DCA	MA
	TAD	MB
	TAD	CM2
	DCA	MB
	TAD	CM3
	DCA	INIT
RAUCH,	TAD I	MA
	DCA	L76
	TAD I	MB
	DCA I	MA
	TAD	L76
	DCA I	MB
	ISZ	MA
	ISZ	MB
	ISZ	INIT
	JMP	RAUCH
	TAD	MA
	TAD	CM2
	DCA	MA
	JMP	AA	/NOW THEYRE SWITCHED, CHECK AGAIN
KICK2,	CLA CMA		/MOVE BACK FIRST POINTER
	TAD	MA
	DCA	MA
	JMP	AAC
KICK1,	ISZ	MA	/MOVE UP FIRST POINTER
	ISZ	MIKE7	/ARE WE OUT OF ENTRIES
	JMP	AAB	/NO
/
/ 	NOW THE SORTING IS DONE
/
	JMS 	INIT	/INITIALIZE POINTERS
	DCA	TOTAL	/ZERO OUT TOTAL
MIKE2,	ISZ	MA
	TAD I	MA
	JMS I	PRSYM	/PUT OUT THE SYMBOL
	TAD	C7240
	JMS I	P2	/PUT OUT THE TERMINATOR
	IAC
	TAD I	MA
	DCA	L14
	TAD I	L14	/GET CONTROL BITS FROM SYMBOL TABLE
	AND	P20
	SNA CLA		/IS IT DIMENSIONED
	JMP	MIKE5	/NO
	TAD I	MA	/YES, COMPUTE THE TOTAL LENGTH
	JMS I	DIM
	DCA	L26
	TAD I	L14
	CIA
	DCA	L73
	TAD	L26
	ISZ	L73
	JMP	.-2
	SKP		/GOT IT
MIKE5,	IAC		/IF NOT DIMENSIONED, USE ONE A LENGTH
	DCA	MB	/SAVE LENGTH 
	TAD I	MA
	JMS I	MODE	/WHAT IS THE MODE OF THE SYMBOL
	TAD	MB	/FP, MULTIPLY BY THREE
	RAL CLL
	TAD	MB
	DCA	INIT	/SAVE IT
	TAD	TOTAL	/GET TOTAL REMAINING LENGTH OF STRING
	CIA
	TAD	INIT	/SUBTRACT CURRENT LENGTH FROM IT
	SPA CLA		/WHICH IS BIGGER
	JMP	.+3	/REMAINING PORTION IS BIGGER
	TAD	INIT	/CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION
	DCA	TOTAL
	ISZ	MA
	TAD	MA
	TAD	C3
	DCA	MB
	TAD I	MB	/GET NEXT ENTRY STRING NUMBER
	CIA
	TAD I	MA	/SUBTRACT CURRENT STRING NUMBER
	SZA CLA		/ARE THEY EQUAL
	JMP	MIKE1	/NO
	ISZ	MA	/YES, GET THE DIFFERENCE
	ISZ	MB
	TAD I	MB
	CIA
	TAD I	MA
	DCA	MB	/AND SAVE
	TAD	MB	/SUBTRACT DIFFERENCE FROM TOTAL REMAINING
	CIA
	TAD	TOTAL
MIKE6,	DCA	TOTAL	/SAVE
	TAD	MB	/GET THE DIFFERENCE
	DCA	L26
	JMS I	BSS	/RESERVE THAT MANY LOCATIONS
	ISZ	MIKE7	/ARE WE DONE
	JMP	MIKE2	/NO
	JMP I	ROGER	/YES
MIKE1,	TAD	TOTAL	/SWITCH TOTAL TO THE CURRENT LOCATION
	DCA	MB
	ISZ	MA	/EQUALIZE POINTERS
	JMP	MIKE6
/
INIT,	0
	TAD	MIKE8	/GET ENTRY COUNT
	CIA		/SET NEGATIVE
	DCA	MIKE7	/SAVE
	TAD	POINTZ	/GET TABLE POINTER
	DCA	MA	/SAVE
	JMP I	INIT
/
ROGER,	PTEMP
P20,	20
$