A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / pass3.pa

/3 OS/8 FORTRAN  (PASS THREE)
/
/ VERSION 4A PT 16-MAY-77
/
/	OS/8 FORTRAN IV COMPILER-PASS 3
/
/	BY: HANK MAURER
/	UPDATED BY: R. LARY + M. HURLEY
/
/
/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
VERSON=4
\f/ PAGE ZERO STUFF
	OUDEVH=7000		/PUT OUDEVH AND OUBUF IN DIFFERENT
	INDEVH=6400
	INBUF=6000
	OUBUF=5400		/SEGMENTS, STAN KNOWS WHY
	X10=10
	X11=11
	X12=12
	NCHARS=20
	CHAR=21
	TEMP=22
	FILDEV=6
	FILBLK=7
	DEV1CE=173		/THROUGH 177
	DEVH=23
	LINENO=24
	SEVCHR=25		/THROUGH 33


/	OS/8 V3C MAINTENANCE RELEASE FIXES:

/1.	EXTENDED RANGE OF PAGE NUMBERS TO 99
/2	INTERCHANGED CR/LF FOR HASSINGER
/3	CHANGED VERSION NO. TO 305
/5.	ADDED 'I' TO JMP (OFOO3
/
/
/	CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
/	.CHANGED VERSION NUMBER TO 4A
/	.PUT IN NEW DATE ALGORITHM
/
/
\f/START OF PASS 3
	*400			/DON'T LOAD INTO 0-377
SPASS3,	CDF	10
	TAD I	(7666		/GET DATE
	DCA	TEMP
	TAD I	LSTFIL		/COPY FILE NAME
	CDF
	DCA I	FILLST
	ISZ	LSTFIL
	ISZ	FILLST
	ISZ	OFSIZE
	JMP	SPASS3
	TAD	DEV1CE		/FETCH HANDLER FOR OUTPUT FILE
	CIF	10
	JMS I	(200		/USR IS IN CORE
	1
OH,	OUDEVH+1		/TWO PAGE HANDLER IS OK
	JMP I	(OFOO3
	CIF	10
	TAD	DEV1CE		/OPEN THE LISTING FILE
	JMS I	(200
	3
OB,	DEV1CE+1
OS,	0
	JMP I	(OFOO3
	TAD	OB		/SAVE BLOCK NUMBER
	DCA	OBLOCK
	TAD	OS
	DCA	OSIZE		/AND SIZE OF HOLE
	TAD	OH		/SAVE HANDLER ADDRESS
	DCA	DEVH
	TAD	(NUMS-1		/SET UP NUMBER POINTER
	DCA I	(NUM
	TAD	TEMP		/GET THE DATE--FOR YEAR ROUTINE
	SNA
	JMP I	(PAJE		/NO DATE
	AND	(7		/MASK OUT ALL BUT YEAR OFFSET BITS
	DCA	YRTEMP		/INCREMENT FROM THE BASE YEAR
	DCA	TEMP1		/HOLDS THE FIRST DIGIT OF THE YEAR
	TAD I	(7777		/GET THE DATE EXTENSION BITS
	AND	(600		/MASK TO GET THE EXTENSION BITS
	CLL RTR			/ROTATE THEM INTO BIT
	RTR			/POSITIONS 7 AND 8
	TAD	(106		/ADD IN 70---OLD BASE YEAR
	TAD	YRTEMP		/ADD IN THE YEAR OFFSET BITS
				/TO FIND THE NEW BASE YEAR
CONVYR, CLL			/FIND THE YEAR IN DECIMAL
	TAD	(-12		/KEEP SUBTRACTING 12
	SNL			/ALMOST DONE
	JMP 	SECDIG		/FIND THE SECOND DIGIT OF THE YEAR
	ISZ	TEMP1		/FIND THE FIRST DIGIT OF THE YEAR
	JMP	CONVYR		/TRY AGAIN
SECDIG, TAD	(72		/GET THE SECOND DIGIT OF THE YEAR
	RTL			/AND MAKE IT SIXBIT
	RTL
	RTL
	DCA I	(YEAR+1		/PUT IT IN THE PRINT LINE
	TAD	TEMP1		/GET THE FIRST DIGIT
	TAD	(5560		/MAKE IT SIXBIT
	DCA I	(YEAR		/PRINT IT
	TAD	TEMP		/GET THE DATE--NOW FIND THE MONTH/DAY
	CLL RTR
	RAR
	AND	(777
	DCA	TEMP
SIMPLE,	TAD	TEMP		/GET THE DAY
	AND	(37
	TAD	(DAYS-1		/THIS IS THE LAZY WAY
	DCA	NCHARS
	TAD I	NCHARS
	DCA I	(DAY
	TAD	TEMP		/GET THE MONTH
	CLL RTR
	RTR
	AND	(36
	TAD	(MONTHS-3
	DCA	X10
	TAD I	X10
	DCA I	(MONTH
	TAD I	X10
	DCA I	(MONTH+1
	JMP I	(PAJE		/WE GOT THE DATE
LSTFIL,	7605
FILLST,	DEV1CE
OFSIZE,	-5
YRTEMP, 0
TEMP1,  0
\f	PAGE
PAJE,	JMP I	(PRHDR		/PRINT THE FIRST HEADING
	CLL CML RTL		/INITIALIZE LINE NUMBER
	DCA	LINENO
	DCA	TABCNT		/**
RDLUPE,	TAD	(SEVCHR-1	/SEVEN CHAR BUFFER
	DCA	X10
	TAD	(-6
	DCA	NCHARS
RDLOOP,	JMS I	(ICHAR
	JMP	RDACHO		/ECHO & IGNORE SHORT LINES
	TAD	(-211		/IS IT A TAB ?
	SZA CLA
	JMP	NOTAB		/NO
	TAD	(-2
	DCA	TABCNT		/SET POINTER TO DO EXTRA SPACES LATER**
	TAD	(240
	DCA I	X10		/DO A TAB
	ISZ	NCHARS
	JMP	.-3
	JMP	WHAT		/GO LOOK AT THE LINE
NOTAB,	TAD	CHAR
	DCA I	X10		/SAVE THE CHAR
	ISZ	NCHARS
	JMP	RDLOOP
WHAT,	TAD	SEVCHR		/IS IT A COMMNET
	TAD	(-303
	SNA CLA
	JMP	NOISN		/YES, NO INTERNAL STMT NUMBER
	TAD	SEVCHR+5	/IS IT A CONTINUATION ?
	TAD	(-240
	SZA CLA
	JMP	NOISN		/YES, NO ISN
	TAD	LINENO		/NEITHER OF THESE
	JMS I	(ONUMBR		/PRINT ISN
	TAD	LINENO		/2.01/ PUT LINE NUM
	7421			/2.01/ INTO MQ
	CLA			/2.01/ CLA IF NO EAE
	ISZ	LINENO		/BUMP LINE NUMBER
NOISN,	TAD	(211		/TAB
	JMS I	(OCHAR
	TAD	(SEVCHR-1	/PRINT FIRST SEVEN
	DCA	X10
	TAD	(-6
	DCA	NCHARS
	TAD I	X10
	JMS I	(OCHAR
	ISZ	NCHARS
	JMP	.-3
	TAD	TABCNT		/SEE IF A TAB WAS 1ST
	SMA	CLA		/IF YES,NEED 2 MORE SPACES
	JMP	NOTTAB
	DCA	TABCNT		/WAS A TAB
	TAD	(240
	JMS I	(OCHAR
	TAD	(240
	JMS I	(OCHAR
NOTTAB,	JMS I	(ICHAR		/PRINT REST OF LINE
	JMP	ENDLIN
	JMS I	(OCHAR
	JMP	.-3
ENDLIN,	JMS I	(CRLF		/END LINE
	JMS I	(ERRCHK		/CHECK ERROR LIST
	JMP	RDLUPE		/DO NEXT LINE
TABCNT,	0

HEADER, TEXT    '        FORTRAN IV  4AAAA    '
	*.-1
DAY,	4040
MONTH,	4040;4040
YEAR,	TEXT	'                PAGE  '
	*.-1
PAGENO,	TEXT	'ONE'
	ZBLOCK 7	/V3C ROOM FOR LARGE PAGE NUMBERS
RDACHO,	TAD (211
	JMS I (OCHAR
	JMP I (RDECHO
	PAGE
\f	TEXT	"         "
LOS,	TEXT	"ONE      "
NUMS,/	2427;1740;4040
/	2410;2205;0540
/	0617;2522;4040
/	0611;2605;4040
/	2311;3040;4040
/	2305;2605;1640
/	0511;0710;2440
/	1611;1605;4040
/	2405;1640;4040
/	0514;0526;0516
/	2427;0514;2605
	TEXT	"TWO@@@@@"
	TEXT	"THREE@@@"
	TEXT	"FOUR@@@@"
	TEXT	"FIVE@@@@"
	TEXT	"SIX@@@@@"
	TEXT	"SEVEN@@@"
	TEXT	"EIGHT@@@"
	TEXT	"NINE@@@@"
	TEXT	"TEN@@@@@"
	TEXT	"ELEVEN@@"
	TEXT	"TWELVE@@"
	TEXT	"THIRTEEN"
	TEXT	"FOURTEEN"
	TEXT	"FIFTEEN@"
	TEXT	"SIXTEEN@"
	TEXT	"SEVENTEEN"
	TEXT	"EIGHTEEN"
	TEXT	"NINETEEN"
HIS,	TEXT	" TWENTY "
	*.-1
	TEXT	" THIRTY "
	*.-1
	TEXT	"  FORTY "
	*.-1
	TEXT	"  FIFTY "
	*.-1
	TEXT	"  SIXTY "
	*.-1
	TEXT	"SEVENTY "
	*.-1
	TEXT	" EIGHTY "
	*.-1
	TEXT	" NINETY "
	*.-1
	TEXT	"HUNDRED "
	*.-1
DAYS,  4061;4062;4063;4064;4065;4066;4067;4070;4071
	6160;6161;6162;6163;6164;6165;6166;6167;6170;6171
	6260;6261;6262;6263;6264;6265;6266;6267;6270;6271
	6360;6361
MONTHS, 5512;0116		/-JAN
	5506;0502		/-FEB
	5515;0122		/-MAR
	5501;2022		/-APR
	5515;0131		/-MAY
	5512;2516		/-JUN
	5512;2514		/-JUL
	5501;2507		/-AUG
	5523;0520		/-SEP
	5517;0324		/-OCT
	5516;1726		/-NOV
	5504;0503		/-DEC
	IFZERO .&100	<PAGE>
\fENDX,	TAD	(-601		/2.02/ CLEAR END OF BUFFER
	DCA	LINENO		/2.01/ FOR TV: REASONS
	TAD	X232		/2.01/ OUTPUT ^Z
	JMS I	(OCHAR		/2.01/
	ISZ	LINENO		/2.01/
	JMP	.-3		/2.01/
	CIF	10		/CLOSE THE OUTPUT FILE
	TAD	DEV1CE
	JMS I	(200
	4
	DEV1CE+1
FILSIZ,	0
	JMP	(OFOO3
	CDF	10		/LOOK AT OPTIONS
	TAD I	X7643
	CDF
M70,	SPA CLA
	JMP I	(7605		//A MEANS DON'T CHAIN TO RALF
	CIF CDF 10
	TAD	FILDEV		/SET UP RALF INPUT LIST
	DCA I	(7617		/FILE SIZE AND DEVICE CODE
	ISZ	(7617
	TAD	FILBLK		/FILE START
	DCA I	(7617
	ISZ	(7617		/ZERO END OF LIST
	DCA I	(7617
	TAD I	X7643		/IS IT /F (FULL LIST) ?
	AND	(100
	CIF	0
	SZA CLA			/**
	JMP	LISTIT
	CIF	10
	TAD I	(7644
	AND	(20		/LET /T SWITCH THRU ALSO
	SNA CLA
	DCA I	(7605		/NO, INHIBIT RALF LISTING
LISTIT,	CIF	10
	CLA IAC
	CDF
	JMS I	(200		/LOOKUP RALF.SV
	2
	RALFNM
X7643,	7643
	JMP	(OFOO3
	TAD	.-3
	DCA	.+4
	CIF	10		/CHAIN TO RALF
	JMS I	(200
	6
X232,	232
NCNT,	0
ONUMBR,	0
	DCA	TEMP		/OUTPUT ISN IN OCTAL
	TAD	(-4
	DCA	NCNT
OLOOP,	TAD	TEMP
	CLL RTL			/ANYONE WHO CAN'T FOLLOW THIS
	RAL			/SHOULDN'T BE A PROGRAMMER
	DCA	TEMP
	TAD	TEMP
	RAL
	AND	(7
	TAD	(260
	JMS I	(OCHAR
	ISZ	NCNT
	JMP	OLOOP
	JMP I	ONUMBR
CONVRT,	0			/CONVERT TO ASCII AND PRINT
	AND	(77
	SZA
	TAD	(-40
	SPA
	TAD	(100
	TAD	(240
	JMS I	(OCHAR
	JMP I	CONVRT
LINECT,	-1			/EJECT FIRST TIME
CRLF,	PAJE+1
	TAD	(215		/CR LF
	JMS I	(OCHAR
	TAD	(212
	JMS I	(OCHAR
	ISZ	LINECT
	JMP I	CRLF
	TAD	(214
	JMS I	(OCHAR
PRHDR,	TAD	M70		/RESET COUNT
	DCA	LINECT
	TAD	(HEADER		/COPY HEADER OUT
	DCA	TEMP
OHDR,	TAD I	TEMP
	CLL RTR
	CLL RTR
	CLL RTR
	JMS	CONVRT
	TAD I	TEMP
	JMS	CONVRT
	TAD I	TEMP		/END YET ?
	ISZ	TEMP
	AND	(77
	SZA CLA
	JMP	OHDR
	TAD	(215		/V3C SKIP EXTRA LINE AFTER TITLE
	JMS I	(OCHAR
	TAD	(212		/V3C
	JMS I	(OCHAR		/FOR CENTRONICS
	JMP	PUTNUM		/GET NEW PAGE NUMBER
\f/ OS/8 FILE INPUT ROUTINES
	PAGE
ICHAR,	0			/READ CHAR FROM INPUT FILE
	ISZ	INJMP		/BUMP THREE WAY UNPACK SWITCH
	ISZ	INCHCT
INJMPP,	JMP	INJMP
	TAD	INEOF		/DID LAST READ YEILD END OF FILE ?
	SNA CLA
	JMP	INGBUF		/NO, DO ANOTHER READ
GETNEW,	JMS	INNEWF		/OPEN A NEW INPUT FILE
	JMP I	(ENDX		/NO FILE TO OPEN
INGBUF,	TAD	INCTR		/BUMP RECORD COUNTER
	CLL IAC
	SNL
	DCA	INCTR		/RESTORE IF IT HASN'T OVERFLOWED
	SZL
	ISZ	INEOF		/SET END OF FILE SWITCH
	JMS I	INHNDL		/DO THE READ
INCALL,	200
INBUFP,	INBUF
INREC,	0
	JMP	INERR		/HANDLER ERROR
INBREC,	ISZ	INREC		/BUMP RECORD NUMBER
	TAD	(-601		/SET CHAR COUNT
	DCA	INCHCT
	TAD	INJMPP		/RESET THREE WAY JUMP SWITCH
	DCA	INJMP
	TAD	INBUFP		/RESET BUFFER POINTER
	DCA	INPTR
	JMP	ICHAR+1		/GO AGAIN
INERR,	ISZ	INEOF		/EITHER EOF OR BADDIE
	SMA CLA
	JMP	INBREC		/END OF FILE, DO NEXT FILE
	JMP	OFOO3
INJMP,	HLT			/3 WAY CHARACTER UUPACK SWITCH
	JMP	ICHAR1
	JMP	ICHAR2
ICHAR3,	TAD	INJMPP		/RESET JUMP SWITCH
	DCA	INJMP
	TAD I	INPTR
	AND	(7400		/COMBINE THE HIGH ORDER BITS
	CLL RTR			/OF THE TWO WORDS
	RTR
	TAD	INTMP		/TO FORM THE THIRD CHAR
	RTR
	RTR
	ISZ	INPTR		/BUMP WORD POINTER
	JMP	ICHAR1+1	/DO SOME COMMON STUFF
ICHAR2,	TAD I	INPTR		/SAVE THE HIGH ORDER BITS
	AND	(7400
	DCA	INTMP		/FOR THE THIRD CHAR
	ISZ	INPTR		/GO TO THE SECOND WORD
ICHAR1,	TAD I	INPTR		/GET THE LOW 8 BITS
	AND	(377		/AND I MEAN ONLY 8 !!
	DCA	CHAR
	TAD	CHAR
	TAD	(-232		/IS IT ^Z (END OF FILE)
	SNA
	JMP	GETNEW		/YES, LOOK FOR THE NEXT FILE
	TAD	(232-212
	SNA
	JMP	ICHAR+1		/IGNORE LINE FEEDS
	TAD	(212-215
	SNA
	JMP I	ICHAR		/RETURN ON CARRIAGE RETURN
	IAC
	SNA CLA
	JMP	ICHAR+1		/IGNORE FORM FEEDS
	TAD	CHAR
	ISZ	ICHAR
	JMP I	ICHAR		/RETURN TO THE CALLING WORLD
INTMP,	0
INFPTR,	7617			/POINTER TO INPUT FILE LIST
INEOF,	1
INCHCT,
INNEWF,	-1			/FETCH HANDLER FOR NEXT FILE
	TAD	(INDEVH+1	/THIS IS WHERE IT GOES
	DCA	INHNDL
	CDF	10
	TAD I	INFPTR		/GET NEXT INPUT FILE INFO
	CDF
	SNA
	JMP I	INNEWF		/NO MORE FILES
	CIF	10
	JMS I	INCALL		/CALL MONITOR
	1			/FETCH HANDLER
INHNDL,	0			/ENTRY ADDR GOES HERE
	JMP	OFOO3
	CDF	10
	TAD I	INFPTR		/GET LENGTH
	AND	(7760
	SZA			/A ZERO HERE MEANS >=256 BLOCKS
	TAD	(17		/PUT IN SOME MORE BITS
	CLL CML RTR
	RTR
	DCA	INCTR		/STORE LENGTH OF FILE
	ISZ	INFPTR
	TAD I	INFPTR		/GET STARTING RECORD NUMBER
	DCA	INREC
	ISZ	INFPTR
	DCA	INEOF		/CLEAR EOF FLAG
	ISZ	INNEWF
	CDF
	JMP I	INNEWF
INCTR,	0
INPTR,	0
/PUTNUM,	TAD	(PAGENO-1	/COPY THE NEW NUMBER
/	DCA	X10
/	TAD I	NUM
/	ISZ	NUM
/	DCA I	X10
/	TAD I	NUM
/	ISZ	NUM
/	DCA I	X10
/	TAD I	NUM
/	ISZ	NUM
/	DCA I	X10
/	JMP	CRLF+1
RDECHO,			/KEEP LINES WITH L.T. 6 CHARS OUT OF ISN COLUMN
	TAD	(SEVCHR-1
	DCA	X12
RDECLP,	TAD	X12
	CIA
	TAD	X10
	SNA CLA
	JMP	ENDLIN	/ONLY ECHO WHAT YOU READ
	TAD I	X12
	JMS I	(OCHAR
	JMP	RDECLP
\f	PAGE
OUDUMP,	0			/BUMP THE DUFFER
	TAD	OSIZE		/ANY ROOM LEFT ?
	IAC
	SNA
	JMP	OFOO3
	DCA	OSIZE		/YES, ITS OK
	JMS I	DEVH		/WRITE
	4200			/CONTROL WORD
	OUBUF			/BUFFER POINTER
OBLOCK,	0			/BLOCK NUMBER
	JMP	OFOO3
	ISZ	OBLOCK		/INCREMENT BLOCK NUMBER
	ISZ	FILSIZ		/AND FILE SIZE
	TAD	OBLOCK-1	/SET BUFFER POINTER
	DCA	OUPTR
	TAD	(-200		/SET DOUBLE WORD COUNT
	DCA	OUWDCT
	JMP I	OUDUMP
OCHAR,	0			/OUTPUT A CHAR TO THE RALF INPUT FILE
	AND	(377
	DCA	OUTEMP		/SAVE CHAR
	KSF			/^C TEST
	JMP	NOSTOP
	KRB
	AND	(177
	TAD	(-3
	SNA CLA
	JMP I	(7605		/YES
NOSTOP,	ISZ	OUJUMP		/BUMP 3 WAY SWITCH
OUJUMP,	JMP	.
	JMP	CHAR1
	JMP	CHAR2
	TAD	OUTEMP		/HIGH FOUR BITS GO INTO
	CLL RTL			/THE HIGH ORDER BITS OF THE
	RTL			/FIRST WORD OF THE TWO WORD PAIR
	AND	(7400		/SEE NOTE * BELOW
	TAD I	OUPOLD		/COMBINE WITH OTHER BITS
	DCA I	OUPOLD
	TAD	OUTEMP		/THE OTHER FOUR BITS OF THIS CHAR
	CLL RTR			/GO INTO THE HIGH ORDER FOUR
	RTR			/BITS OF THE SECOND WORD OF THE PAIR
	RAR
	AND	(7400
	TAD I	OUPTR
	DCA I	OUPTR
	TAD	OUJMP		/RESET 3 WAY BRANCH
	DCA	OUJUMP
	ISZ	OUPTR		/BUMP BUFFER POINTER
	ISZ	OUWDCT		/AND DOUBLE WORD COUNTER
	JMP I	OCHAR		/BUFFER NOT FULL
	JMS	OUDUMP		/DUMP IT
	JMP I	OCHAR
CHAR2,	TAD	OUPTR		/SAVE FIRST WORD POINTER
	DCA	OUPOLD
	ISZ	OUPTR		/GO TO SECOND WORD
CHAR1,	TAD	OUTEMP		/STORE CHAR 1 OR 2
	DCA I	OUPTR
	JMP I	OCHAR
OUTEMP,	0
OUPOLD,	0
OUPTR,	OUBUF
OUJMP,	JMP	OUJUMP
OUWDCT,	-200
OSIZE,	0
ERRPTR,	5000
ERRCHK,	0
	CDF	10
	TAD I	ERRPTR		/ANY ERRORS FOR THIS LINE
	CDF
	CMA
	TAD	LINENO
	SZA CLA
	JMP I	ERRCHK		/NO
	CLL CMA RAL		/BACK UP POINTER
	TAD	ERRPTR
	DCA	ERRPTR
	TAD	ERRPTR
	IAC
	DCA	TEMP
	CDF	10
	TAD I	TEMP		/GET CODE
	CDF
	CIA
	DCA	TEMP		/SAVE NEGATIVE
	TAD	(ERRLST-1
	DCA	X10
FIND,	TAD I	X10		/LOOK FOR ERROR MESSAGE
	SZA
	TAD	TEMP
	SNA CLA
	JMP	.+3
	ISZ	X10
	JMP	FIND		/SKIP POINTER WORD
	CLA CMA
	TAD I	X10
	DCA	X10		/POINTER TO MESSAGE
PMLOOP,	TAD I	X10		/GET TWO CHARS
	DCA	TEMP
	TAD	TEMP
	RTR
	RTR
	RTR
	JMS	CONVRT		/PRINT FIRST
	TAD	TEMP
	JMS	CONVRT		/PRINT SECOND
	TAD	TEMP
	AND	(77		/END OF MESSAGE ?
	SZA CLA
	JMP	PMLOOP		/NO, LOOP
	JMS I	(CRLF
	JMP	ERRCHK+1	/SEE IF ANY MORE FOR THIS LINE
RALFNM,	FILENAME RALF.SV
\f	PAGE
X304,	304
X305,	305
X7605,	7605
OFOO3,	TAD	X304		/FATAL ERROR IN PASS 3
	JMS	TTY
	TAD	X305
	JMS	TTY
	JMP I	X7605
TTY,	0			/PRINT ON TTY
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	TTY
/ERROR MESSAGES
ERRLST,	0724;GT
	1124;IT
	0504;ED
	2227;RW
	0317;CO
	0530;EX
	2123;QS
	2114;QL
	1106;IF
	0417;DO
	2316;SN
	2404;TD
	0204;BD
	2224;RT
	2204;RD
	2324;ST
	0314;CL
	1517;MO
	1017;HO
	1515;MM
	2323;SS
	1720;OP
	0123;AS
	0401;DA
	0410;DH
	1514;ML
	0405;DE
	0223;BS
	1424;LT
	1105;IE
	2010;PH
	1513;MK
	1724;OT
	2004;PD
	1524;MT
	0726;GV
	1411;LI
	0420;DP
	0414;DL
	0101;AA
	2306;SF
	0406;DF
	1111;II
	0;SYSERR
SYSERR,	TEXT	'UNDEFINED ERROR'
II,	TEXT	'ILLEGAL USE OF IF'
GT,	TEXT	'BAD GOTO STATEMENT'
RW,	TEXT	'BAD READ OR WRITE STATEMENT'
CO,	TEXT	'ARGS IN COMMON OR VAR IN TWO COMMONS OR SYNTAX BAD'
IT,	TEXT	'BAD IO LIST ELEMENT'
EX,	TEXT	'BAD EXTERNAL STMT'
QS,	TEXT	'SYNTAX ERROR IN EQUIVALENCE'
QL,	TEXT	'VARIABLE IS EQUIVALENCED MORE THAN ONCE'
IF,	TEXT	'THIS KIND OF STATEMENT NOT LEGAL AFTER LOGICAL IF'
DO,	TEXT	'BAD SYNTAX IN DO OR IMPLIED DO'
SN,	TEXT	'NOT LEGAL AS SUBROUTINE NAME'
TD,	TEXT	'SYNTAX ERROR IN TYPE STATEMENT'
BD,	TEXT	'DIMENSIONS TOO BIG, OR SYNTAX ERROR IN DIMENSION LIST'
ED,	TEXT	'ILLEGAL AS DO ENDING STATEMENT'
RT,	TEXT	'ATTEMPT TO RE-TYPE A VARIABLE'
RD,	TEXT	'ATTEMPT TO RE-DIMENSION A VARIABLE'
ST,	TEXT	'INTERNAL COMPILER ABORT NUMBER ONE'
CL,	TEXT	'ERROR IN COMPLEX LITERAL'
MO,	TEXT	'OPERAND EXPECTED, NONE PRESENT'
HO,	TEXT	'HOLLERITH COUNT WRONG, OR MISSING QUOTES'
MM,	TEXT	'MISMATCHED PARENTHESIS'
SS,	TEXT	'SUBSCRIPT OR ARGUMENT LIST ERROR'
OP,	TEXT	'ILLEGAL OPERATOR'
AS,	TEXT	'ASSIGN ???'
DA,	TEXT	'DATA STATEMENT ?'
DH,	TEXT	'HOLLERITH COUNT OR QUOTE ERROR IN DATA STATEMENT'
ML,	TEXT	'THIS LINE NUMBER IS ALREADY DEFINED'
DE,	TEXT	"WRONG WAY TO END A DO LOOP"
BS,	TEXT	'ILLEGAL IN BLOCK DATA'
LT,	TEXT	'LINE TOO BIG'
IE,	TEXT	'INPUT FILE ERROR, TAKEN AS END STATEMENT'
PH,	TEXT	'THIS FUNCTION / SUBROUTINE STATEMENT IS UNACCEPTABLE'
MK,	TEXT	'YOU MISPELED A KEYWURD'
OT,	TEXT	'ILLEGAL OPERAND TYPE FOR THIS OPERATOR'
PD,	TEXT	'INTERNAL COMPILER ABORT NUMBER TWO'
MT,	TEXT	"ILLEGAL VARIABLE TYPE MIXING"
GV,	TEXT	'VARIABLE IN ASSIGNED OR COMPUTED GOTO MUST BE INTEGER OR REAL'
LI,	TEXT	'EXPRESSION IN LOGICAL IF IS NOT TYPED LOGICAL'
DP,	TEXT	'DO PARAMETERS MUST BE INTEGER OR REAL'
DL,	TEXT	"YOUR DATA AND VARIABLE LISTS ARE OF DIFFERENT LENGTHS"
AA,	TEXT	'SUBROUTINES MAY ONLY HAVE SIX ARGUMENTS THAT ARE DIMENSIONED'
SF,	TEXT	'BAD STATEMENT FUNCTION'
DF,	TEXT	'BAD DEFINE FILE'
\fPAGEN,	1

PUTNUM,	ISZ PAGEN	/BUMP PAGE NUMBER
	TAD PAGEN
	TAD (-24	/LT 20?
	SMA CLA
	JMP OVER19	/YES
	TAD (-5		/NO
	JMS MOVE	/MOVE IN NUMBER
NUM,	0
	PAGENO-1
	TAD NUM
	TAD (5
	DCA NUM		/PT TO NEXT ONE
	JMP I (CRLF+1

TENS,	0
ONES,	0
KNT,	0

OVER19,	DCA TENS	/CONVERT
	TAD PAGEN	/PAGE NUMBER TO ONES AND TENS
O1,	TAD (-12	/DIVIDE BY TEN
	SPA
	JMP .+3
	ISZ TENS
	JMP O1
	TAD (12
	DCA ONES
	TAD TENS
	CLL RTL
	TAD (HIS-10-1
	DCA HIP		/POINT TO HIGH PART
	TAD ONES
	CLL RTL
	TAD ONES
	TAD (LOS-5-1
	DCA LOP
	TAD (-4
	JMS MOVE
HIP,	0
	PAGENO-1
	TAD (-5
	JMS MOVE
LOP,	0
	PAGENO+4-1
	JMP I (CRLF+1
\fMOVE,	0
	DCA KNT
	TAD I MOVE
	DCA X11
	ISZ MOVE
	TAD I MOVE
	DCA X12
	ISZ MOVE
	TAD I X11
	DCA I X12
	ISZ KNT
	JMP .-3
	JMP I MOVE
	$
\f