
FORTRAN II - TAPE 1 SERVICE ROUTINES

FIODEC

/SOME SMALL POOR SUBS - I.E. - SUB- ROUTINES

SPECHR,	SAD (CHAR R
				EXIT	/C.R.
	SAD (CHAR R		EXIT	/TAB
	SAD (CHAR R 		EXIT	/SPACE
	EXIT1

/RETURN WITH THE NEW CHARACTER IN THE AC

NEWCHR,	GCR
	SPECHR
	EXIT
	SAD (74
	JMP NEWCAS
	SAD (72
	JMP NEWCAS
	ADD CASE#M
	EXIT

NEWCAS,	DAC CA#SE
	RAL6
	AND (7700
	DAC CASEM
	JMP NEWCHR

/INITIALIZE ABOVE ROUTINES

SETCHR,	LAC (CHAR R
	DAC SCAN#CH
	LAC (7200
	DAC CASEM
	LAC (72
	DAC CASE			/SET TO LOWER CASE
	DZM UCASE
	EXIT

/PACK AND UNPACK STATEMENT ROUTINES

PACK,	DAC N#CHR
	LAC CASE
	SAD N#CASE
	JMP . 3
	DAC NCASE
	PACK0
	LAC NCHR
PACK0,	AND (77
PACKM,	XX
	JMP PACK1
	JMP PACK2

PACK3,	XOR I CPOINT
	AND (77
	XOR I CPOINT
	DAC I CPOINT
PACK3A,	ISZ CPOINT
	LAW CPOINT CN
	SAD CPOINT
	HELP EH 1606
	LAC (JMP PACKM 1
	DAC PACKM
PACK3B,	LAC NCHR
	EXIT

PACK1,	RAR7
	XOR I CPOINT
	AND (770000
PACK1A,	XOR I CPOINT
	DAC I CPOINT
	ISZ PACKM
	JMP PACK3B

PACK2,	RAL6
	XOR I CPOINT
	AND (7700
	JMP PACK1A

/SET UP THE PACK AND UNPACK ROUTINES

PACKST,	LAW CPOINT
PAKSET,	DAC CPOINT
	LAM -0
	DAC U#PACKT
	LAC (140000
	DAC U#PAKCH
	DZM UCASE
	LAW CPOINT
	DAC U#POINT
	JMP PACK3A

/UNPACK THE STATEMENT

NXTCHR,	IDXCHR
UNPACK,	LAC UPAKCH
	RAL7
	AND (77
	SAD (13
	EXIT			/ALL DONE
	SPECHR
	EXIT1
	SAD (74
	JMP UNPAK0 1
	SAD (72
	JMP UNPAK0
	SAD (14
	JMP NXTCHR
	ADD U#CASE
	EXIT1

UNPAK0,	CLA
	RAL6
	AND (7700
	DAC UCASE
	JMP NXTCHR

UPAK1,	LAC UPAKCH
	JMS RL6
UPAK2,	DAC UPAKCH
	AND (770000
	XCT SPACES
	SZA
	EXITR

IDXCHR,	ISZ UPACKT
	JMP UPAK1
	ISZ UPOINT
	LAM -2
	DAC UPACKT
	LAC I UPOINT
	JMP UPAK2


SPACES,	NOP

/PUNCH STRING

TEMX=17

PUNSTR,	DAC TEMX
	LAM -2
	DAC T#EMCNT
	LAC I TEMX
PUNST1,	DAC T#EMP
	AND (770000
	SAD (130000
	EXIT
	SAD (140000
	SKP
	PUNCH1
	LAC TEMP
	RAL6
	ISZ TEMCNT
	JMP PUNST1
	JMP PUNSTR+1

/PUNCH THE SYMBOL IN COMMON

PUNADR,	PUNSYM
PUNCOM,	LAW CHAR R,
PUNCHR,	JMP PUNCHW

PUNSTY,	PUNSTR
PUNSYM,	LAC COMMON
	PUNCH3
	LAC COMMON 1
	JMP PUNCH3

PUNPER,	LAW CHAR R.
	JMP PUNCHW

PUNSTD,	PUNSTR
	LAC COMMON
	JMP DECPUN

PUNDCC,	DECPUN
	JMP PUNCRR

PUNADG,	DAC TEMCNT
	PUNPER
	LAC TEMCNT
	PUNCH3
	JMP PUNCOM

PUNJMP,	DAC TEM#
	LAW DOGOM-1
	PUNSTR
	LAC TEM
	JMP DIMV4


/GET THE NEXT ARGUMENT


GETARG,	GETSYM
	JMP GETA0		/NO MORE CHARACTERS
	JMP GETA1		/A NUMBER OR VARIABLE
	EXIT			/A PUNCTUATION

GETA0,	CLA			/0 MEANS EMPTY
	EXIT

GETA1,	DSPTCH
	JMP GETA2
	JMP GETA3

GETA4,	PVSTAK
	FIXFLO
	JMP . 3
	LAC (2
	JMP GETA5
	LAC (3
	JMP GETA5

GETA2,	PCSTAK
	LAC (1)
	JMP GETA5

GETA3,	FLCONS
	DAC COMMON 1
	LAC (FLEX .   1414
	DAC COMMON
	PVSTAK
	CLA

GETA5,	DAC IND#CAT	/EXIT FROM HERE WITH AC
	UNPACK		/00 MEANS A FLOAT CONSTANT
	JMP . 3		/01 MEANS A FIXED CONSTANT
	SAD (CHAR R,	/10 MEANS A FLOAT VAR
	IDXCHR		/11 MEANS A FIXED VAR
	LAC INDCAT	/FIRST BIT IN THE LINK
	RTR		/SECOND IN ACO
	EXIT1

/SOME MORE MISC SMALL SUBS

CHKCOM,	LAW CHAR R,
CHKNXT,	AND (7777
	DAC TEMC
	UNPACK
	EXIT
	SAD TEMC
	SKP
	EXIT
	IDXCHR
	EXIT1

CHKLPR,	LAW CHAR R(
	CHKNXT
	HELP 702
	EXIT

CHKRPR,	LAW CHAR R)
	CHKNXT
	HELP 703
	EXIT

GETFIX,	GETARG
	HELP 1201
	SMA
	HELP 1202
	LAC VPOIN1
	EXIT

GETVAR,	GETSYM
	EXIT
	SKP
	EXIT
	SAD (2
	EXIT1
	EXIT

GETCON,	GETARG
	EXIT
	LAC INDCAT
	SAD (1
	EXIT1
	HELP 1203
	EXIT

GETFXV,	GETFIX
	AND (300000
	SZA
	HELP 1204
	JMP GETVAR-2


/SCAN ROUTINE - PACK STATEMENT, DISPATCH ON TYPE

SCAN,	SAVE	-AN
	DZM C#COMMA
	DZM C#EQUAL
	DZM STAT#NI
	CLEARI
	LAC (12
	DAC CTEN
	PACKST
	PUNCRR
	LAC SCANCH
SCANA,	SAD (CHAR R
	JMP SCANS
	SAD (7263
	JMP SCANC
	SAD (7222
	JMP SCANC 2
	SKP

SCANBG,	NEWCHR
	SAD (CHAR R		/TAB
	JMP SCANTB
	DAC PAC
	AND (7700
	SAD (7200
	SKP
	HELP 701
	LAC PAC
	AND (77
	DIGIT
	HELP 701
	LAC I2
	DAC ST#NUM
	LAW
	DAC FOFFF
	DAC STATNI
	JMP SCANBG

SCANTB,	NEWCHR
	SAD (CHAR R	
	JMP SCANTB
	JMP SCAN0 1

SCANS,	NEWCHR
	JMP SCANA

/MORE SCAN

	CAL SCAN1
SCAN0,	NEWCHR
	SAD (CHAR R
	JMP SCAN0A		/DONE
	PACK
	SAD (7257
	JMP SCAN0-1
	SAD (7255
	HELP 704
	SAD (7233
	ISZ CCOMMA
	SAD (FLEX  =
	ISZ CEQUAL
	JMP SCAN0

	CAL SCAN1
SCAN1,	NEWCHR
	SAD (CHAR R
	JMP SCAN1A
	PACK
	SAD (7257
	JMP SCAN1-1
	SAD (7255
	EXIT
	JMP SCAN1

SCAN0A,	SCAN2
	JMP SCAN0
	JMP SCAN3

SCAN1A,	SCAN2
	JMP SCAN1
	HELP 705

SCAN2,	NEWCHR
	DAC SCANCH
	SAD (7440
	SKP
	EXIT1
	NEWCHR
	SAD (CHAR R	
	EXIT
	JMP .-3

SCAN3,	LAW 13
	PACK
	LAC CEQUAL
	SNA
	JMP CONTROL
	LAC CCOMMA
	SZA
	JMP DOSTAT
	JMP ARITH

SCANC,	LAW CHAR R/
	PUNCHW
	COPY
	JMP SCANS

/GET SYMBOL

GETSYM,	UNPACK		/GET NEXT CHARACTER
	EXIT		/ALL DONE
	CHRTYP
	JMP GETSN	/DIGIT
	JMP GETSY	/LETTER
	SAD (CHAR R.	/OTHER
	JMP GETSN
	EXIT2R		/"PUNCT" - LEARN

GETSN,	GETNUM
	EXIT1

GETSY,	DAC NCHR
	LAC (141414	/ALPHANUMERIC SYMBOL IN
	DAC COMMON	/SET UP TO READ AND PACK
	DAC COMMON+1
	LAM -6
	DAC TEMCNT
	LAW COMMON-1
	DAC CPOINT
	PACK3A

GETSY1,	GETPAK
	NXTCHR
	JMP GETSY2
	CHRTYP
	JMP GETSY1
	JMP GETSY1

GETSY2,	LAW CHAR R.
	GETPAK
	LAC (2
	EXIT1

GETPAK,	ISZ TEMCNT
	PACK0
	LAC TEMCNT
	SNA!CLC
	DAC TEMCNT
	EXIT


/UN PEU SUB

GETOPN,	SAD (FLEX  ^	LAW EXPOP
	SAD (FLEX  *	LAW MULOP
	SAD (FLEX  +	LAW ADDOP
	SAD (FLEX  =	LAW EQUOP
	SAD (FLEX   /	LAW DIVOP
	SAD (FLEX   -	LAW SUBOP
	SAD (FLEX   (	LAW UNOPEN
	SAD (FLEX   )	LAW CLOSEO
		SAD (FLEX   ,	LAW COMOP
	AND (17777
	EXIT

START
