
4-TRAN OUTPUT AND OVERHEAD ROUTINES

FIODEC
AUTOG0=10	AUTOG1=11

/SEARCH ROUTINE

SEARCH,	DAC #SEARCA
	AND (17777
	SNA
	EXIT
	LAC PAC
	DAC #SEARCC
	RAL5
	AND (17
	CMA
	DAC #SEARCT	/COUNT OF COMPARISONS
	LAC (SAD COMMON
	DAC SP#OINT
SELOOP,	LAC I SEARCA
	DAC #SEARCB
	LAC SEARCT
	DAC #SEARCN
	JMP SELOO1

SELOO2,	ISZ SEARCA
	LAC I SEARCA
	XCT SPOINT
	JMP SEARCS
	LAC SEARCB
	SNA
	EXIT
	DAC SEARCC
	DAC SEARCA
	JMP SELOOP-2

SEARCS,	ISZ SPOINT
SELOO1,	ISZ SEARCN
	JMP SELOO2
	LAC SEARCC
	EXIT1

NFREE,	0		/NEXT FREE REGISTER
TYPE0,	100000		/DUMMY SYMBOL TABLE
TYPE1,	100000		/DIMENSIONED VARIABLE
TYPE2,	140000		/FLOATING POINT CONSTANT
TYPE3,	100000		/USED FUNCTION
TYPE4,	100000		/COMMON
TYPE5,	100000		/DIMENSIONED DUMMY SYMBOL
TYPE6,	100000		/DECLARED TYPES

ADVSTK,	LAW POLEND-1
	SAD IT
	HELP SCE 1
	LAC #VPOIN1	/ADVANCE POINTER
	ISZ IT
	DAC I IT
	EXIT

PVSTAK,	LAM -3		/PUT VARIABLES IN STACK
	ADD VPOINT
	DAC VPOINT
	DAC VPOIN1
	CMA
	ADD NFREE
	SMA
	HELP SCE 2
	LAC COMMON
	DAC I VPOINT
	ISZ VPOINT
	LAC VPOINT
	SAD NFREE
	HELP SCE 2
	LAC COMMON+1
PCCOM,	DAC I VPOINT
	ISZ #VARS
	EXIT

INSERT,	DSPARA		/INSERT INTO LIST
	LAC PAC
	AND (17
	DAC #NUMINS
	XCT PARA+1
	AND (17777
	SNA
	JMP FINSERT
	XCT PARA+1
	SEARCH
	SKP
	EXIT1
CINSERT,	LAC NFREE
	DAC I SEARCC
	DAC SEARCB
	DZM I SEARCB
	ISZ SEARCB
	ADD NUMINS
	DAC NFREE
	ISZ NFREE
	CMA
	ADD VPOINT
	SPA
	HELP SCE 3
	LAC NUMINS
	CMA
	DAC NUMINS
	ISZ NUMINS
	LAW COMMON
	DAC #TEMP

INLOOP,	LAC I TEMP
	DAC I SEARCB
	ISZ TEMP
	ISZ SEARCB
	ISZ NUMINS
	JMP INLOOP
	LAC I SEARCC
	EXIT2

FINSERT,	XCT PARA+1
	XOR NFREE
	DAC I PARA+1
	LAC NFREE
	JMP CINSERT+2

/GENERATE SYMBOL ROUTINE

GENSYM,	ISZ RIGHT
	LAW GETEND+1
	SAD RIGHT
	JMP NRIGHT
GEN2,	CLL!CLA
	XOR (6100
	XOR I MIDDLE	RAL6
	XOR I RIGHT
	EXIT

NRIGHT,	ISZ MIDDLE
	SAD MIDDLE
	HELP SCE 4
NRI2,	LAW GETAB
	DAC RIGHT
	JMP GEN2

MIDDLE,	LAW GETAB
RIGHT,	LAW GETAB-1

/PUT CONSTANT IN STACK

PCSTAK,	LAM -2
	ADD VPOINT
	SAD NFREE
	HELP SCE 5
	DAC VPOINT
	XOR (300000
	DAC VPOIN1
	LAC COMMON
	JMP PCCOM

/RESTORE
RESET1=JMS .	0
	LAW GETAB-1
	DAC RIGHT
	DAC MIDDLE
	ISZ MIDDLE
	JMP I RESET1-JMS

RESET,	CLC
	DAC #EXPCOT
	DZM STNUM
	DZM EXTSWT
	LAW 1
	DAC #TYPSWT
	DZM #NORSWT
	DZM #XVAR
	DZM DO#NUM
	DZM #COMSWT
	LAC NOPER
	DAC #SPACES
	DAC #XSTATW
	DAC WSIZE
	DAC #SWITCH
	DAC #FUNSWT
	DZM #FOFFF
	LAC #END
	DAC NFREE
	LAC (100000
	DAC TYPE0
	DAC TYPE1
	DAC TYPE3
	DAC TYPE4
	DAC TYPE5
	DAC TYPE6
	LAC (140000
	DAC TYPE2
	LAC (LAC I POLISH
	DAC TOP
	DZM #NUMAX
	LAC (CMT CRTURN
	DAC POLISH
	LAC THEEND
	DAC VPOINT
STRESET,	LAW POLISH
	DAC IT
	DAC #VARS
	DZM #ACIND
	DZM TEM#IND
	DZM #OVSYM
	DZM NUM#TEM
	EXIT

GETAB,	CHAR RA	CHAR RB	CHAR RC	CHAR RD	CHAR RE
	CHAR R1	CHAR RG	CHAR RH	CHAR RI	CHAR RJ
	CHAR RK	CHAR RL	CHAR RM	CHAR RN	CHAR RO
	CHAR RP	CHAR RQ	CHAR RR	CHAR RS	CHAR RT
	CHAR RU	CHAR RV	CHAR RW	CHAR RX	CHAR RY
GETEND,	CHAR RZ

POPTOP,	LAC TOP
	ADD (LAW-LAC-I-1
	DAC IT
TOPPOP,	LAM -1
	ADD TOP
	DAC TOP
	LAC I TOP
	SMA
	JMP TOPPOP
	EXIT

PTYPE1,	LAC TYPE1
	AND (17777
	SNA
	JMP PTYPE2
	DAC AUTOG1
	DAC #PTEMP
	LAC I AUTOG1
	DAC COMMON
	LAC I AUTOG1
	DAC COMMON+1
	LAC TYPE4
	SEARCH
	SKP
	JMP P4COM
	LAC I AUTOG1
	PUNADG
	PUNTAB
	LAC I AUTOG1
	DAC COMMON+3
	LAC (LAC FPSC
	FIOFLP
P4COM,	LAC I PTEMP
	JMP PTYPE1+1

FPSC,	FLEX .  +77		/.,SPACE,CRT

RAR9,	RAR
RAR8,	RAR
RAR7,	RAR
RAR6,	RAR
RAR5,	RAR
RAR4,	RAR
RAR3,	RAR
RAR2,	RTR
	EXIT


PTYPE2,	LAC TYPE2
	AND (17777
	SNA
	JMP PTYPE4
	DAC AUTOG1
	DAC PTEMP
	ADD (3
	WSIZE
	DAC #PTEMP2
	LAC I PTEMP2
	PUNADG
	LAM -1
	XCT WSIZE
	LAM -2
	DAC PTEMP2
IPT2LO,	PUNTAB
	LAC I AUTOG1
	DECPUN
	ISZ PTEMP2
	JMP IPT2LO
	PUNCRR
	LAC I PTEMP
	JMP PTYPE2+1

PUNCH3,	PUNCH1
	SKP
PUNCH2,	RAL
	PUNCH1+1
	SKP
PUNCH1,	RAL
	RAL6

PUNCHW,	DAC #PUNCHS
	AND (77
	SAD (14
	JMP PUNCHX
	PARITY
	ADD (200
	IPB
PUNCHX,	LAC PUNCHS
	EXIT

RAL9,	RAL
RAL8,	RAL
RAL7,	RAL
RAL6,	RAL
RAL5,	RAL
RAL4,	RAL
RAL3,	RAL
RAL2,	RTL
	EXIT


PTYPE4,	LAW TEMMES-1
	PUNSTR
	LAC COMSWT
	SNA
	JMP PTYPE6
	LAC EXTSWT
	RAR
	LAW XNDMES-1
	SNL
	LAW ENDMES-1
	PUNSTR
	DZM EXTSWT
	LAC TYPE4
PTYPE5,	AND (17777
	SNA
	JMP PTYPE6
	DAC AUTOG1
	DAC #PTEMP
	LAC I AUTOG1
	DAC COMMON
	LAC I AUTOG1
	DAC COMMON+1
	LAC TYPE1
	SEARCH
	JMP NDIMV
	ADD (2
	DAC AUTOG1
	LAC I AUTOG1
	DAC COMMON+1
	LAC I AUTOG1
	DAC COMMON+3
	LAC (LAC FPMT
	FIOFLP
	LAC COMMON+1
	PUNADG
COMRET,	PUNCRR
	LAC I PTEMP
	JMP PTYPE5

NDIMV,	LAW 1
	DAC COMMON+3
	LAC (LAC FPMT
	FIOFLP
	PUNADR
	JMP COMRET

FPMT,	FLEX .- +36

SCE=EH 1600

COMMON,	COMMON+4/
IT,	LAW POLISH

TEMMES,	TEXT .TEM,
.
ENDMES,	TEXT .

END/
.
XNDMES,	TEXT .

XND/
.
TEMME2,	TEXT .TEM+.
TEMME3,	TEXT ./

START
.

PTYPE6,	PUNCRR
	LAC NUMAX
	SZA
	CMA
	AND (17777
	DAC COMMON
	LAW TEMME2-1
	PUNSTD
	LAW TEMME3-1
	JMP PUNSTR

/DETERMINE FLOATING POINT WORD SIZE

WSIZE,	XX		/SET TO NOP OR SKP
	ADD (1
	EXIT

/FIXED OR FLOATING AND PUNCH

FIOFLP,	DAC FFPUN
	FIXFLO
	JMP FFPUN
	LAC COMMON+3
	AND (17777
	RCL
	XCT WSIZE
	ADD COMMON+3
	DAC COMMON+3
FFPUN,	HLT
	PUNCH2
	LAC COMMON+3
	AND (17777
	DECPUN
	LAC (CHAR R/
	PUNCHW
	XCT FFPUN
	JMP PUNCHW


/DETERMINE MODE OF IDENTIFIER

FIXFLO,	LAC COMMON
	SNA!CMA		/ZERO DENOTES FIXED
	EXITR
	SNA!CMA		/ZERO DENOTES FLOATING
	EXIT1R
	AND (-7777	/MASK TO FIRST CHARACTER
	SAD (CHAR L.	/CHECK FOR FLOATING CONSTANT
	EXIT1R		/YES, SO FLOATING EXIT
	LAC TYPE6
	SEARCH		/SEE IF DECLARED VARIABLE
	JMP FUNNOR	/NO, SO PROCESS ACCORDING TO NORMAL MODE
	LAC I SPOINT	/GET MODE IDENTIFIER
FUNNY2,	AND (3
	DSPTCH		/DISPATCH ON MODE TYPE
	EXITR		/FIXED POINT VARIABLE
	JMP FUNREG	/FORTRAN TYPE
	HLT		/NOT ASSIGNED
	EXIT1R		/FLOATING POINT VARIABLE

FUNNOR,	LAC TYPSWT
	JMP FUNNY2

FUNREG,	LAC COMMON+1
	SAD (FLEX F. +14
	JMP FUNYES
	AND (7777
	SAD (FLEX  F.
	JMP FUNYES
	AND (77
	SAD (FLEX   F
SKPCON,	SKP
	JMP REGFOR
FUNYES,	LAC COMMON
	AND (770000
	SAD (CHAR LX
	EXITR
	EXIT1R

REGFOR,	LAC COMMON
	AND (770000
	SAD (710000
	EXITR
	SMA
	EXIT1R
	ADD (320000
	SPA
	EXITR
	EXIT1R

/PARITY GENERATION ROUTINE

PARITY,	DZM #PARITC
	JMP .+3
	SZL
	ISZ PARITC
	CLL!SZA!RAR
	JMP PARITY+2
	LAC PARITC
	RAR
	SZL
	EXIT1R
	EXITR

/FLOATING CONSTANT LOOKUP
/RETURNS WITH GEN. SYMBOL IN AC

FLCONS,	LAW COMMON+2
	WSIZE
	DAC FLCO1
	GENSYM	/VALUE OF CONSTANT IS IN COMMON-COMMON+1 OR 2
	DAC I FLCO1
	LAW 3
	WSIZE
	INSERT
	LAC TYPE2
	JMP .+3
	LAC I #FLCO1	/NEW DEFINITION
	EXIT
	ADD (3		/SET TO PICK UP SYMBOL ALREADY DEFINED
	WSIZE
	DAC SEARCC	/FREE AT THIS TIME
	LAC I SEARCC	/PICK UP GEN. SYMBOL
	EXIT

/DECIMAL INTEGER PUNCH SUBROUTINE

DECPNT,	LAC (DECPR2
	JMP DCPUN2
DECPUN,	DAC PAC
	LAC (PUNCHW
DCPUN2,	DAC DECIOS
	DAC DECIO2
	LAC PAC
	CLL!SMA
	CMA!CML
	DAC DCPN#UM
	LAW CHAR R-
	SNL
DECIOS,	XX
	LAC (ADD DCPTAB
	DAC DCPLOP 2
	LAM -4
	DAC DCPC#NT
	LAC (SZA
	DAC DCPMOD

DCPGDG,	DZM DCPD#IG
	LAC DCPNUM
	JMP . 3

DCPLOP,	DAC DCPNUM
	ISZ DCPDIG
	XX
	SPA
	JMP DCPLOP
	ISZ DCPLOP 2
	LAC DCPDIG
DCPMOD,	XX
	JMP DPPUN
	ISZ DCPCNT
	JMP DCPGDG
	LAC DCPNUM
	CMA
	SNA
	LAW 20
	JMP I DECIOS
DECPR2,	JMS TYPDIG
	EXIT

DPPUN,	SNA
	LAW 20
DECIO2,	XX
	LAC (OPR
	DAC DCPMOD
	JMP DCPMOD+2

DECIMAL

DCPTAB,	100000	10000	1000	100	10	1


OCTAL

START
