perm filename M3.MAC[SIM,SYS] blob sn#465738 filedate 1979-07-26 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBTTL	M3	REL and ATR file creation
C00006 00003		SUBTTL	M3 main loop
C00010 00004		IF	Not main program
C00014 00005		SUBTTL	M3ATR
C00027 00006		SUBTTL	M3GR
C00029 00007		SUBTTL	M3IQ
C00032 00008		SUBTTL	M3LT
C00035 00009		SUBTTL	M3NO
C00036 00010		SUBTTL	M3ST
C00039 00011
C00041 00012	M3UNR:
C00042 00013		TABLE CONTAINING ADDRESSES OF ROUTINES TO BE USED AT CURRENT HEADER
C00043 00014	
C00044 ENDMK
C⊗;
	SUBTTL	M3	REL and ATR file creation


;AUTHOR:		ELISABETH $LUND
;VERSION:		3[42]
;PURPOSE:		CREATE A REL FILE ADAPTED TO THE OLD LOADER
;			CREATE ATR FILE
;CONTENTS:	
;LOCAL SUBROUTINES:	M3ATR	COMPARE ATR FILES
;			M3GR	CONVERT BLOCKS OF TYPE 2
;			M3IQ	CONVERT BLOCKS OF TYPE 10
;			M3LT	BLOCK CONTAINING LINE NUMBER TABLE
;			M3CO	CONVERT BLOCKS OF TYPE 1013, CODE AND PROTOTYPE
;			M3ST	CONVERT BLOCKS OF TYPE 1014, SYMBOLS
;			M3UNR	GENERATE UNIQUE NUMBER
;			M3NUNR	GENERATE UNIQUE NUMBER = PRECEDING UNIQUE NUMBER +1
;NORMAL EXIT:		RETURN
;ERROR EXIT:		T3T3	AT ERROR ON IC2



	SEARCH SIMMAC

	CTITLE	M3

	SEARCH	SIMMCR
	SEARCH	SIMMC3	;[104]
	MACINIT
	P3INIT	;[104]
	SALL

	TWOSEG
	RELOC	400000



	QOHATR==4	;[12]

;EXTERNAL SUBROUTINES

EXTERN	O3RA		;READ .ATR
EXTERN	O3ATR		;READ ATR.TMP
EXTERN	O3ATRC		;CHECK IF CORE FOR ATR.TMP
EXTERN	O3WATR		;WRITE ATR
EXTERN	O3RI		;READ WORDS FROM IC2
EXTERN	O3RIB		;INPUT BUFFER FROM IC2
EXTERN	O3WIB		;WRITE WORDS TO REL
EXTERN	I3E		;OPEN .ATR
EXTERN	I3I		;OPEN IC2
EXTERN	T3I		;CLOSE IC2 RENAME REL
EXTERN	T3R		;DEL REL.TMP
EXTERN	T3T3		;ERROR ROUTINE

;DATA
EXTERN	IDLA	;[12]
EXTERN	ZSE		;SYMBOL TABLE
EXTERN	.JBREL
EXTERN	YSWITCH		;SWITCH WORD
EXTERN	YBHEXT		;BUFFERHEADER .ATR
EXTERN	YBHIC2		;BUFFER HEADER IC2
EXTERN	YBHREL		;BUFFER HEADER REL FILE
EXTERN	YNOREL		;START OF REL COUNTERS
EXTERN	Y3SIEN		;NUMBER OF WORDS IN ENTRY LIST ATR
EXTERN	Y3UNR1		;FOR UNIQUE NUMBER
EXTERN	Y3UNR2		;FOR UNIQUE NUMBER
EXTERN	Y3ATRE		;POINTER END OF ATR.TMP
EXTERN	Y3ATE2		;POINTER ATR
EXTERN	Y3PLTE		;POINTER END OF LINE NUMBER TABLE
EXTERN	Y3PLTS		;POINTER FIRST FREE PLACE LINE NUMBER TABLE
EXTERN	YCADLV
EXTERN	YCANTRY		;START ADDRESS AT EXECUTION
EXTERN	Y3REL		;REL COUNTER
EXTERN	YM3B		;LOCAL BUFFER CODE PROTOTYPE AND INTERNAL REQUEST STREAMS
EXTERN	YM3BI		;INDEX OF FIRST FREE PLACE IN YM3BI
EXTERN	YM3BRP		;POINTER REL WORD IN YM3B
EXTERN	YRELBL		;[6] Number of blocks filled on REL file
EXTERN	Y3ENTRY		;[6] Entry point name or zero
INTERN	M3		;MODULE ENTRY


;MACRO TO GENERATE TABLE CONTAINING NAMES IN SIXBIT FORMAT OF RTS ROUTINES
;THE TABLE IS USED WHEN THE NAMES ARE TO BE OUTPUT TO THE REL FILE


	DEFINE	X(A,B,C,D)<
		IFL<A-400K>,<
			IFNB<D>,<RADIX50 60,D>
			IFB<D>,<RADIX50 60,.'A>
			    >
			  >

	DEFINE	Y(A,B,C,D)<
		X(A,B,C)>

	SUBTTL	M3 main loop

M3:
	PROC

	;COUNT NUMBER OF WORDS IN DIFFERENT STREAMS TO LOADER

	LI	X2,1
	SETZB	X3,Y3REL
	SETZM	Y3REL+1
	LOOP	
		ADD	X3,YNOREL(X2)
		ST	X3,Y3REL+1(X2)
	AS
		CAIE	X2,5
		AOJA	X2,TRUE
	SA
	SETZM	YM3BI				;RESET START INDEX
	SETZM	Y3ENTRY	;[6] Entry point undefined
	;CREATE POINTER FOR LINENUMBER TABLE
	IF	;Main program
		IFOFF	Y3MP
		GOTO	FALSE
	THEN	;CREATE POINTER FOR LINE NUMBER TABLE
		LI	X0,IDL
		ST	X0,Y3PLTE
		ST	X0,Y3PLTS
	ELSE	;EXT CLASS or PROC, GENERATE ATR FILE
		EXEC	M3ATR
		IF
			;REL FILE IS TO BE GENERATED IF SIMULA
			IFON	Y3ESIM
			GOTO	FALSE
		THEN
			IFOFF	Y3ECLA
			GOTO	M3END
		FI
		L	Y3ENTRY		;[6] Entry name or 0
		IF	;[6] Nonzero name and entry block still not output
			JUMPE	FALSE
			HRRZ	X1,YRELBL	;Number of full buffers so far
;[16]			Revised because of problems with io
;[16]			CAIL	X1,2		;Less than two buffers?
;[16]			GOTO	FALSE
			JUMPN	X1,FALSE	;[16] Works only if none output
		THEN	;Change entry name without much trouble
;[16]			CAIL	X1,1		;Less than one?
;[16]			SKIPA	X1,@YBHREL	;No, find 1st buffer
			L	X1,YBHREL	;Yes, use current buffer
			ST	4(X1)
			SETZM	Y3ENTRY		;Indicate no further change necessary
		FI	;[6]
	FI
	EXEC	I3I				;OPEN	IC2
	;FIRST PART OF OUTPUT BUFFER IS FILLED, MOVE TO LOCAL BUFFER
	;COMPUTE START INDEX IN BUFFER
	HRRZ	X1,YBHREL
	HRRZ	X2,YBHREL+1
	HRRM	X1,YBHREL+1
	AOS	YBHREL+1
	SUBI	X2,1(X1)
	ST	X2,YM3BI
	HRLI	X1,2(X1)
	HRRI	X1,YM3B
	BLT	X1,YM3B-1(X2)
	REPEAT	0,<	;[16] Code no good, wait till we get older and wiser
	IF	;[6] Global class/proc and
		; 1st buffer full and not yet output
		L	YRELBL
		JUMPGE	FALSE
		HRRZ
		JUMPE	FALSE
		CAIE	1
		GOTO	FALSE
	THEN	;Output it first
		L	X1,@YBHREL
		OUT	QCHREL,(X1)
		SOSGE	YBHREL+2
		GOTO	[
			L	QT,[ASCIZ /REL/]
			ERRT	QT,Q.TER+4
			BRANCH	T3T3
		]
	FI	;[6]
	>	;[16] End repeat 0


	WHILE
		EXEC	O3RI			;READ WORD
		SKIPA				;CORRECT RETURN
		GOTO	FALSE
	DO
		HLRZ	X1,X0
		HRRZ	X10,X0			;NUMBER OF WORDS UNTIL NEXT HEADER WORD

		;CHECK FOR BLOCK TYPE

		MOVSI	X2,-6
		;CHECK IF CORRECT HEADER IN IC2 AND CALL CURRENT ROUTINE
		IF
			CAMN	X1,M3TYP(X2)
			GOTO	FALSE
	
		THEN
			AOBJN	X2,.-2
			;ERROR FAULTY HEADER IN IC2
			ASSERT	<OUTSTR [ASCIZ /FAULTY HEADER IN IC2
				/]>
			ERRT	QT,Q.TER+3
			BRANCH	T3T3
		FI
		EXEC	@M3BL(X2)
	OD


	IF	;Not main program
		IFON	Y3MP
		GOTO	FALSE
	THEN	;SIMULA CLASS/PROC,OUTPUT ENTRIES (GLOBAL DEFINITIONS)
		;MOVE ENTRIES TO LOCAL BUFFER AND OUTPUT TO REL FILE
		L	X3,Y3SIEN
		L	X2,YM3BI
		LI	X1,YM3B(X2)
		HRL	X1,Y3ATRE
		;COMPUTE NUMBER OF FREE WORDS LEFT IN LOCAL BUFFER
		LI	X0,QBL
		SUB	X0,X2
		IF	;Sufficient
			CAMGE	X0,X3
			GOTO	FALSE
		THEN	ADD	X2,X3
			ST	X2,YM3BI
			BLT	X1,YM3B-1(X2)
		ELSE	;THE ENTRIES NEED MORE THAN THIS BUFFER
			LI	X2,QBL
			BLT	X1,YM3B-1(X2)
			ADDM	X0,Y3ATRE
			SUB	X3,X0
			EXEC	M3UT
			WHILE
				CAIGE	X3,QBL
				GOTO	FALSE
			DO
				L	X0,Y3ATRE
				LI	X1,QBL
				ADDM	X1,Y3ATRE
				SUBI	X3,QBL
				EXEC	O3WIB
			OD
			LI	X1,YM3B
			HRL	X1,Y3ATRE
			BLT	X1,YM3B-1(X3)
			ST	X3,YM3BI
		FI
		L	X2,YM3BI
	ELSE	;Main program
		L	X2,YM3BI	;Insert START address def (type 7 block)
		LD	X0,M3BL7
		STD	X0,YM3B(X2)
		L	X1,YCANTRY
		ADD	X1,Y3REL+QRELCD
		ST	X1,YM3B+2(X2)
		ADDI	X2,3
		LD	X4,M3GL2	;Define global symbols (type 2 block)
		STD	X4,YM3B(X2)
		L	X0,M3MAIN
		STD	X0,YM3B+2(X2)	;.MAIN defined
		L	X0,M3MAIL
		L	X1,Y3REL+QRELLT+1
		SUBI	X1,1
		STD	X0,YM3B+4(X2)	;.MAINL defined
		ADDI	X2,6
	FI
	IF	;SIMULATION level defined
		SKIPN	X1,YCADLV
		GOTO	FALSE
	THEN
		IF	;Not main program
			IFON	Y3MP
			GOTO	FALSE
		THEN	;External SIMULA CLASS/PROC
			L	X3,M3GL2
			LI	X4,0
			STD	X3,YM3B(X2)
			ADDI	X2,2
		ELSE	;block will have 4 more words
			ADDI	X4,4
			ST	X4,YM3B-6(X2)
		FI
		L	X0,M3SIML	;.SIMLV defined
		STD	X0,YM3B(X2)
		L	X0,M3SIMN	;.SIMVL (-.SIMLV) defined
		HRRES	X1
		MOVNS	X1
		STD	X0,YM3B+2(X2)
		ADDI	X2,4
	FI
	LD	X0,M3BL5	;End block (type 5)
	STD	X0,YM3B(X2)
	L	X0,Y3REL+6			;PROGRAM BREAK
	ST	X0,YM3B+2(X2)
	SETZM	YM3B+3(X2)
	ADDI	X2,4
	CAILE	X2,QBL
	EXEC	M3UT


	;OUTPUT LAST BUFFER, WHICH MAY BE PARTLY FILLED

	LI	X0,YM3B
	L	X1,X2
	EXEC	O3WIB
	EXEC	T3I				;DELETE IC2.TMP RENAME REL.TMP
M3END:
	RETURN
	EPROC
	SUBTTL	M3ATR


;PURPOSE		COMPARE OLD AND NEW ATR FILE,IF UNEQUAL OUTPUT NEW ATR
;ENTRY:			M3ATR
;INPUT ARGUMENTS:	-
;NORMAL EXIT:		RETURN
;ERROR EXIT:		-
;OUTPUT ARGUMENTS:	
;			Y3PLTE 	POINTER TO FREE POS IN IDL AFTER DATA FROM ATR FILE TO
;			REL FILE
;			Y3SIEN	NUMBER OF ENTRIES IN IDL
;			THAT ARE TO BE OUTPUT TO THE REL FILE
;			Y3ATRE	POINTER TO POS AFTER ATR.TMP
;CALL FORMAT:		EXEC	M3ATR


M3ATR:	PROC
	SAVE	<X2,X3,X4,X5,X6>
	;READ	ATR.TMP INTO CORE,RETURN Y3ATRE POINTER TO POS AFTER LIST
	EXEC	O3ATR
	;INDEX ATRLIST
	LI	X3,IDLA+1
	LI	X5,0

	LOOP
		;REPLACE ID NUMBER WITH NAME AMONG ATTRIBUTES
		IF
			IFEQF	(X3,ZDETYP,ZHB%V)
			;COUNT ZHB
			AOJA	X5,FALSE
		THEN
			;ZQU
			LF	X1,ZQULID(X3)
			LF	X2,ZQUQID(X3)
			LSH	X1,1
			LD	X0,ZSE-4000(X1)
			STD	X0,2(X3)
			SETF	0,ZQULID(X3)
			IF
				JUMPE	X2,FALSE
			THEN
				;TWO IDENTIFIERS
				LSH	X2,1
				LD	X1,ZSE-4000(X2)
			ELSE
				;ONE IDENTIFIER
				LI	X1,0
			FI
			STD	X1,4(X3)
			ADDI	X3,1
		FI
		ADDI	X3,5
	AS
		SKIPE	(X3)
		GOTO	TRUE
		SOJE	X5,FALSE
		AOJA	X3,.-3
	SA
	ADDI	X3,1
	ST	X3,Y3ATE2
	;REPLACE ID NUMBERS WITH NAME IN PART 3
	WHILE
		SKIPN	(X3)
		GOTO	FALSE
	DO
		LF	X1,ZHELID(X3)
		LSH	X1,1
		LD	X0,ZSE-4000(X1)
		STD	X0,2(X3)
		ZF	ZHELID(X3)
		ADDI	X3,4
	OD


	IF	;Old ATR file did not exist or could not be opened
		EXEC	I3E
		GOTO	FALSE
	THEN	;A new unique number is needed
		SETONA	NEWUNR
	ELSE	;Read old file and compare
		SOSGE	YBHEXT+2
		EXEC	O3RA
		ILDB	X1,YBHEXT+1
		IF	;[12] New ATR file format
			HLRZ	X1
			CAIE	4
			GOTO	FALSE
		THEN	;Skip blocks before 1st comment block
			WHILE	;Not type 0
				JUMPE	FALSE
			DO
				LI	X3,2(X1)
				LOOP	SOSGE	YBHEXT+2
					EXEC	O3RA
					ILDB	X1,YBHEXT+1
				AS	SOJG	X3,TRUE
				SA
				HLRZ	X1
			OD
			SOSGE	YBHEXT+2
			EXEC	O3RA
			ILDB	X1,YBHEXT+1
		FI	;[12]
		SETONA	OLDATR
		IF
			IFON	Y3ESIM
			GOTO	FALSE
			IFON	Y3ECLA
			GOTO	FALSE
		THEN
			;MACRO/FORTRAN
			;COMPARE HEADER
			CAME	X1,IDLA
			SETONA	NEWATR
		ELSE
			ST	X1,IDLA
		FI


		;COMPARE ATTRIBUTES IN OLD AND NEW ATR FILE
		LI	X3,IDLA+1
		LOOP
			;START OF NEW RECORD
			;SAVE POINTER TO START OF RECORD
			LI	X5,(X3)
			LF	X2,ZDETYP(X3)
			HRLI	X3,-6
			SKIPN	(X3)
			HRLI	X3,-1
			LOOP
				;COMPARE WORDS IN CURRENT RECORD AND ZEROWORDS
				;READ ATR
				SOSGE	YBHEXT+2
				EXEC	O3RA
				ILDB	X1,YBHEXT+1
				IF
					CAMN	X1,(X3)
					GOTO	FALSE
				THEN	;WORDS DIFFER
					;ZQUIND ZHBUNR AND ZQUUNR MAY DIFFER
					LI	X6,(X3)
					IF	;ZHB
						CAIE	X2,ZHB%V
						GOTO	FALSE
					THEN
						IF	;[42] Unique number
							CAIE	X6,OFFSET(ZHBUNR)(X5)
							GOTO	FALSE
						THEN	;Accept difference
							ST	X1,(X3)	;Use old
							SKIPN	Y3ENTRY	;[6] Entry point
							ST	X1,Y3ENTRY ;[6] first time
							ADD	X3,[1,,0]
						ELSE	;Length field may differ
							CAIE	X6,OFFSET(ZHELEN)(X5)
							GOTO	M3ADIF
							XOR	X1,(X3)
							SIZE(Q,ZHELEN)
							Q1==<1←<Q>-1>B<%ZHELEN>
							Q2==%ZHELEN-↑d18
							IFL	<Q2>,<
							TLZ	X1,(Q1)
							>
							IFG	<Q2+1>,<
							IFG	<Q2+1-Q>,<
							TRZ	X1,Q1
							>
							IFL	<Q2-Q>,<
							Q1==1-Q1
							AND	X1,[Q1]
							>
							>
							JUMPN	X1,M3ADIF
							;Only length differed.
							;Accepted, since any
							;real difference will
							;show up in other places
						FI	;[42]
					ELSE	;ZQU
						IFNEQF	(X5,ZQUMOD,QDECLARED)
						GOTO	M3ADIF
						IF
							CAIE	X6,OFFSET(ZQUIND)(X5)
							GOTO	FALSE
						THEN	;CHECK IF REST OF WORD EQUAL
							XOR	X1,(X3)
							TLNE	X1,-1
							GOTO	M3ADIF
							;IND MAY DIFFER IF
							;DECL CLASS/PROC/LABEL/SWITCH

							LF	X0,ZQUKND(X5)
							IF
								CAIE	X0,QPROCE
								CAIN	X0,QCLASS
								GOTO	FALSE
								LF	X0,ZQUTYP(X5)
								CAIN	X0,QLABEL
								GOTO	FALSE
							THEN
								GOTO	M3ADIF
							FI
						ELSE
							CAIE	X6,OFFSET(ZQUUNR)(X5)
							GOTO	M3ADIF
							IFNEQF	(X5,ZQUTYP,QLABEL)
							GOTO	M3ADIF
							ST	X1,(X3)
						FI
					FI
				FI
			AS
				AOBJN	X3,TRUE
			SA	;END OF A RECORD

		AS
			;CHECK IF MORE RECORDS
			CAME	X3,Y3ATE2
			GOTO	TRUE
		SA
		WHILE
			SKIPN	(X3)
			GOTO	FALSE
		DO
			;COMPARE PART 3 CHECKS
			HRLI	X3,-4
			LOOP
				SOSGE	YBHEXT+2
				EXEC	O3RA
				ILDB	X1,YBHEXT+1
				CAME	X1,(X3)
				GOTO	M3CDIF
			AS
				AOBJN	X3,TRUE
			SA
		OD
		SOSGE	YBHEXT+2
		EXEC	O3RA
		ILDB	X1,YBHEXT+1
		SKIPE	X1
M3CDIF:
		SETONA	NEWATR
	FI


	IF
		IFOFFA	NEWUNR
		GOTO	FALSE
	THEN
		;GENERATE NEW UNIQUE NUMBERS
M3ADIF:
		EXEC	M3UNR
		SETONA	NEWATR
		SETONA	NEWUNR
		IF	;CLASS
			IFOFF	Y3ECLA
			GOTO	FALSE
		THEN	;Define symbol for ZCPSBL
			EXEC	M3NUNR
			ST	X1,IDLA
		FI
		LD	X3,Y3UNR1	;[6] Save unique name info
		EXEC	M3NUNR		;[6] Entry name
		ST	X1,Y3ENTRY	;[6] Save it
		STD	X3,Y3UNR1	;[6] Restore to old status
		LI	X3,IDLA+1
		LOOP
			IF	;Not ZQU
				IFEQF	(X3,ZDETYP,ZQU%V)
				GOTO	FALSE
			THEN
				;ZHB OR ZERO WORD
				IF
					SKIPN	(X3)
					AOJA	X3,FALSE
				THEN	;GET NEW UNIQUE NUMBER
					EXEC	M3NUNR
					SF	X1,ZHBUNR(X3)
					ADDI	X3,5
				FI
			ELSE	;ZQU
				IF	;Declared and (LABEL or SWITCH)
					IFNEQF	(X3,ZQUMOD,QDECLARED)
					GOTO	FALSE
					IFNEQF	(X3,ZQUTYP,QLABEL)
					GOTO	FALSE
				THEN
					EXEC	M3NUNR
					SF	X1,ZQUUNR(X3)
				FI
				ADDI	X3,6
			FI
		AS
			CAME	X3,Y3ATE2
			GOTO	TRUE
		SA
	FI
	IF
		IFON	Y3ECLA
		GOTO	TRUE
		IFOFF	Y3ESIM
		GOTO	FALSE
	THEN
		;SIMULA PROCEDURE /CLASS
		;DEF ENTRIES TO BE OUTPUT TO REL FILE
		;COMPUTE SPACE THAT WILL BE NEEDED BY LIST CONTAINING ENTRIES
		L	X1,Y3ATE2
		L	X2,Y3ATRE
		SUBI	X1,IDLA
		LSH	X1,-1
		SUBI	X2,IDLA
		ADD	X1,X2
		;CHECK IF SPACE FOR LIST AFTER ATR.TMP
		EXEC	O3ATRC
		LI	X3,IDLA+1
		L	X4,Y3ATRE
		ADDI	X4,1
		LI	X5,0
		IF
			SKIPN	X1,IDLA
			GOTO	FALSE
		THEN	;RELOCATE ZCPSBL
			TLO	X1,600000
			LF	X2,ZQUIND(X3)
			SUBI	X2,1
			ADD	X2,Y3REL+QRELPT
			TLO	X2,600000
		FI
		WHILE
			;OUTPUT ENTRIES AFTER ATR IN CORE
			IF	;Nonzero entry
				JUMPE	X1,FALSE
			THEN
				IF
					SOJG	X5,FALSE
				THEN
					;RELOCATION WORD
					L	X0,[OCT 042104210421]
					ST	X0,(X4)
					LI	X5,↑D9
					ADDI	X4,1
				FI
				STD	X1,(X4)
				ADDI	X4,2
				LI	X1,0
			FI
			CAML	X3,Y3ATE2	;End of list?
			GOTO	FALSE
			SKIPN	(X3)		;Skip zero words
			AOJA	X3,.-3
		DO
			IF	;Not ZQU
				IFEQF	(X3,ZDETYP,ZQU%V)
				GOTO	FALSE
			THEN	;ZHB
				LF	X1,ZHBUNR(X3)
				TLO	X1,40000
				ADDI	X3,5
			ELSE	;ZQU
				IF	;Declared
					IFNEQF	(X3,ZQUMOD,QDECLA)
					GOTO	FALSE
				THEN	;Define code address of symbol
					LF	X2,ZQUIND(X3)
					;RELOCATE ADDRESS
					IF	;LABEL or SWITCH
						IFNEQF	(X3,ZQUTYP,QLABEL)
						GOTO	FALSE
					THEN
						LF	X1,ZQUUNR(X3)
						TLO	X1,40000
						IF	;Simple label
							IFNEQF	(X3,ZQUKND,QSIMPLE)
							GOTO	FALSE
						THEN	;REL TO CODE
							ADD	X2,Y3REL+QRELCD
						ELSE	;CLASS or PROC,
							;REL TO PROTOTYPE
							ADD	X2,Y3REL+QRELPT
						FI
					ELSE
						;REL TO PROTOTYPE
						ADD	X2,Y3REL+QRELPT
					FI
				FI
				ADDI	X3,6
			FI
		OD
		;CREATE HEADER WORD,COMPUTE LENGTH OF ENTRY LIST
		ST	X4,Y3PLTE
		ST	X4,Y3PLTS
		SUB	X4,Y3ATRE
		ST	X4,Y3SIEN
		LI	X2,-1(X4)
		;EVERY 19TH WORD IS A REL WORD SHOULD NOT BE COUNTED
		IDIVI	X2,↑D19
		SUBI	X4,1(X2)
		SKIPE	X3
		SUBI	X4,1
		HRLI	X4,2
		ST	X4,@Y3ATRE
	ELSE
		;MACRO/FORTRAN
		;DEL REL.TMP
		EXEC	T3R
	FI
	;CREATE NEW ATR IF RELEVANT AND  DEL OLD ATR IF EXISTING AND CLOSE .ATR
	EXEC	O3WATR
	RETURN
	EPROC
	SUBTTL	M3GR


COMMENT ;
PURPOSE:		CONVERT BLOCK TYPE 2 TO SUIT OLD LOADER FORMAT
ENTRY:			M3GR
INPUT ARGUMENTS:	REG X10 CONTAINING NUMBER OF WORDS IN IC2 UNTIL NEXT HEADER WORD
NORMAL EXIT:		RETURN
ERROR EXIT		-
OUTPUT ARGUMENTS:	-
CALL FORMAT		EXEC	M3GR
;

M3GR:
	PROC
	L	X2,YM3BI
	;CREATE HEADER WORD
	MOVSI	X0,2
	HRR	X0,X10
	ST	X0,YM3B(X2)
	ADDI	X2,1
	LI	X4,0				;INDICATE REL WORD
	
M3GRL:
	IF
		SOJGE	X10,FALSE
	THEN
		;NO MORE DATA WORDS IN ITEM
		CAIL	X2,QBL
		EXEC	M3UT
		ST	X2,YM3BI
		RETURN
	FI
	IF	;Relocation word
		SOJG	X4,FALSE
	THEN	;OUTPUT BUFFER IF FILLED
		CAIL	X2,QBL
		EXEC	M3UT
		;RELOCATE ADDRESS PART
		L	X0,[OCT 042104210421]
		ST	X0,YM3B(X2)
		ADDI	X2,1
		LI	X4,↑D9
	FI

	;READ DATA WORD
	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X0,YBHIC2+1
	HLRZ	X5,X0
	TRZ	X5,777700
	ADD	X0,Y3REL(X5)
	HRLI	X0,0
	ST	YM3B+1(X2)
	SUBI	X10,1
	;NEXT WORD CONTAINS INFO ON CURRENT SYMBOL
	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X1,YBHIC2+1
	TLNN	X1,-1
	L	X1,M3GL(X1)
	ST	X1,YM3B(X2)
	ADDI	X2,2
	GOTO	M3GRL
	EPROC

	SUBTTL	M3IQ


;PURPOSE:		CONVERT BLOCK TYPE 10 TO SUIT OLD LOADER FORMAT
;ENTRY:			M3IQ
;INPUT ARGUMENTS:	REG X10 CONTAINING NUMBER OF WORDS TO READ FR IC2
;NORMAL EXIT:		RETURN
;ERROR EXIT:		-
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	M3IQ



M3IQ:
	PROC
	L	X2,YM3BI			;GET INDEX

	EXEC	M3IQH
M3IQL:
	IF
		SOJGE	X10,FALSE
	THEN
		;NO MORE WORDS TO READ
		;OUTPUT BUFFER IF FILLED
		;DELETE LAST WORD IN BUFFER IF REL WORD
		CAIL	X4,↑D18
		SUBI	X2,1
		CAIL	X2,QBL
		EXEC	M3UT
		ST	X2,YM3BI
		RETURN
	FI

M3IQL1:
	IF
		SOJGE	X4,FALSE
	THEN
		;REL WORD
		;OUTPUT BUFFER IF FILLED
		CAIL	X2,QBL
		EXEC	M3UT
		SETOM	YM3B(X2)		;RELOCATE ALL WORDS
		LI	X4,↑D18			;18 DATA WORDS BETWEEN REL WORDS
		AOJA	X2,M3IQL1
	FI

	;READ TWO WORDS GET CURRENT REL COUNTER AND CREATE ONE WORD 

	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X0,YBHIC2+1
	IF
		SKIPN	X0
		;NO OUTPUT OF ZERO WORDS
		;NO REL WORD FOR ZERO WORDS
		AOJA	X4,FALSE
	THEN
		HLRZ	X5,X0
		TRZ	X5,777000
		ADD	X0,Y3REL(X5)
		HRLZM	X0,YM3B(X2)			;FIRST WORD INTO LEFT HALF
	FI
	SUBI	X10,1
	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X0,YBHIC2+1
	JUMPE	X0,M3IQL
	HLRZ	X5,X0
	ADD	X0,Y3REL(X5)
	HRRM	X0,YM3B(X2)
	AOJA	X2,M3IQL
	EPROC


M3IQH:
	;CREATE HEADER WORD
	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X4,YBHIC2+1
	LSH	X4,-1
	HRLI	X4,10		;HEADER BLOCK TYPE
	ST	X4,YM3B(X2)
	ADDI	X2,1
	LI	X4,0
	RETURN


	SUBTTL	M3LT


;PURPOSE:		CONVERT BLOCK TYPE 1013 OR 1015 TO SUIT OLD LOADER FORMAT
;			TYPE 1015 INDICATES LINENUMBER TABLE,
;			WHICH IS SAVED IF LINENUMBER TABLE WANTED IN LISTING
;ENTRY:			M3LT IF TYPE 1015,
;			M3CO IF TYPE 1013
;INPUT ARGUMENTS:	REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
;			REG X1 CONTAINING BLOCK TYPE
;NORMAL EXIT:		RETURN
;ERROR EXIT:		-
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	M3LT	RESP	EXEC	M3CO



M3LT:
	;ENTRY BLOCK TYPE 1015
	L	X11,.JBREL
M3CO:
	PROC
	;BLOCK TYPE 1013
	;SAVE BLOCK TYPE
	L	X12,X1
	;CREATE HEADER AND INIT INDEXES
	EXEC	M3HEAD

M3LTL:
	IF
		SOJGE	X10,FALSE
	THEN
		;NO MORE WORDS IN ITEM
		;OUTPUT BUFFER IF FILLED
		CAIL	X2,QBL
		EXEC	M3UT
		ST	X2,YM3BI
		RETURN
	FI
	;READ WORDS FROM IC2

	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X1,YBHIC2+1
	;CHECK IF RELOCATION WORD
	IF
		SOJGE	X4,FALSE
	THEN
		;SAVE REL WORD
		L	X7,X1
		CAIL	X2,QBL
		EXEC	M3UT
		ST	X7,YM3B(X2)
		LI	X4,↑D18
	ELSE
		;DATA WORD
		;UPDATE WORD USING CURRENT RELOCATION COUNTER
		IF
			JUMPGE	X7,FALSE
		THEN
			;RELOCATE LEFT HALF
			LDB	X6,[POINT 3,X1,2]
			TLZ	X1,700000
			HRLZ	X0,Y3REL(X6)
			ADD	X1,X0
		FI
		LSH	X7,1
		IF
			JUMPGE	X7,FALSE
		THEN
			;RELOCATE RIGHT HALF
			LDB	X6,[POINT 3,X1,20]
			TRZ	X1,700000
			ADD	X1,Y3REL(X6)
		FI
		ST	X1,YM3B(X2)
		LSH	X7,1
	
		;CHECK IF WORD IS LINENUMBER
		IF
			CAIE	X12,1015
			GOTO	FALSE
			IFOFF	YSWY
			GOTO	FALSE
			;START ADDRESS SHOULD NOT BE OUTPUT
			TLNN	X1,-1
			GOTO	FALSE
			JUMPL	X1,FALSE
		THEN
			;LINENUMBER
			;CHECK IF ENOUGH CORE
			IF
				CAML	X11,Y3PLTE
				GOTO	FALSE
			THEN
				;MORE CORE NEEDED
				LI	X0,1000(X11)
				IFG	QTRACE,<EXTERN	YTRPAS
						IFOFF	YTRSW>
				CORE	X0,
				SKIPA
				GOTO	FALSE
				ERRT	QT,560
				BRANCH	T3T3
			FI
			ST	X1,@Y3PLTE
			AOS	Y3PLTE
		FI
	FI
	AOJA	X2,M3LTL
	EPROC
	SUBTTL	M3NO


;PURPOSE:		OUTPUT BLOCK TYPE 0 TO REL FILE
;ENTRY:			M3NO
;INPUT ARGUMENT:	REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
;NORMAL EXIT:		RETURN
;OUTPUT ARGUMENT:		-
;CALL FORMAT:		EXEC	M3NO


M3NO:
	;[43]AT PRESENT BLOCK TYPE 0 IS UTILIZED TO FILL THE REST OF AN IC2 BUFFER
	; AFTER PARTLY FILLED LOCAL CODE STREAM BUFFERS ARE OUTPUT.
	;THIS BLOCK IS NOT OUTPUT TO REL FILE

	SKIPN	X10	;IF A ZERO WORD
	RETURN

	SUBM	X10,YBHIC2+2	;[43] SKIP ALL ZERO WORDS
	RETURN
	SUBTTL	M3ST

;PURPOSE:		CONVERT BLOCK TYPE 1014 CONTAINING SYMBOLS TO SUIT OLD LOADER FORMAT
;ENTRY:			M3ST
;INPUT ARGUMENT:	REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
;NORMAL EXIT:		RETURN
;ERROR EXIT:		-
;OUTPUT ARGUMENTS
;CALL FORMAT:		EXEC	M3ST


M3ST:
	PROC
	;CREATE HEADER AND INIT INDEXES
	EXEC	M3HEAD
	SETZM	YM3BRP

M3STL:
	IF
		SOJGE	X10,FALSE
	THEN
		;NO MORE WORDS IN ITEM
		;OUTPUT BUFFER IF FILLED
		;OUTPUT REL WORD
		LSH	X4,1
		ROT	X7,(X4)
		ST	X7,@YM3BRP
		CAIL	X2,QBL
		EXEC	M3UT
		ST	X2,YM3BI
		RETURN
	FI
	;READ WORD SFROM IC2
	SOSGE	YBHIC2+2
	EXEC	M3IN
	ILDB	X0,YBHIC2+1
	;CHECK IF REL WORD IN ITEM

	IF
		SOJGE	X4,FALSE
	THEN
		;RELOACTION WORD
		;OUTPUT OLD REL.WORD
		SKIPE	YM3BRP
		ST	X7,@YM3BRP
		L	X7,X0
		CAIL	X2,QBL
		EXEC	M3UT
		LI	X0,YM3B(X2)
		ST	X0,YM3BRP
		LI	X4,↑D18
	ELSE
		;DATA WORD
		;UPDATE WORD USING CURRENT RELOCATION COUNTER
		IF
			JUMPGE	X7,FALSE
		THEN
			;RELOCATE LEFT HALF
			LDB	X1,[POINT	3,X0,2]
			TLZ	X0,700000
			HRLZ	X6,Y3REL(X1)
			ADD	X0,X6
		FI
		ROT	X7,1
		IF
			JUMPGE	X7,FALSE
		THEN
			;RELOCATE RIGHT HALF
			LDB	X1,[POINT 3,X0,20]
			TRZ	X0,700000
			IF
				CAIL	X1,QRELID
				GOTO	FALSE
			THEN
				;NO IDENTIFIER
				ADD	X0,Y3REL(X1)
			ELSE
				;IDENTIFIER
				;NO REL
				TLZ	X7,400000
				HRRZ	X6,X0
				LSH	X6,1
				CAIE	X1,QRELID
				;SECOND PART OF NAME
				ADDI	X6,1
				L	X0,ZSE-4000(X6)
			FI
		FI
		ST	X0,YM3B(X2)
		ROT	X7,1
	FI
	AOJA	X2,M3STL
	EPROC

	;CODE COMMON TO OTHER ROUTINES
	;CREATE HEADER AND INIT INDEXES
	;GET INDEX OF BUFFER
M3HEAD:
	L	X2,YM3BI
	;CREATE HEADER WORD
	HRRZI	X3,22(X10)
	MOVSI	X0,1
	HRR	X0,X10
	IDIVI	X3,↑D19
	SUB	X0,X3
	;THERE WILL ALWAYS BE ROOM FOR HEADER
	ST	X0,YM3B(X2)
	ADDI	X2,1
	;INDICATE REL WORD NEXT
	LI	X4,0
	RETURN



M3IN:	;INPUT ANOTHER BUFFER FROM IC2
	IF
		EXEC	O3RIB
		GOTO	FALSE
	THEN
		;ERROR RETURN
		ASSERT	<OUTSTR	[ASCIZ	/FAULTY HEADER IN IC2/]>
M3INER:
		L	X1,[ASCIZ	/IC2/]
		ERRT	QT,Q.TER+3
		BRANCH	T3T3
	ELSE
		SOS	YBHIC2+2
		RETURN
	FI


M3UT:
	;ROUTINE TO OUTPUT LOCAL BUFFER TO REL.TMP
	;INPUT:  REG X2 CONTAINING INDEX OF YM3B

	IF
		CAIGE	X2,QBL
		GOTO	FALSE
	THEN
		LI	X1,QBL
		SUBI	X2,QBL
	ELSE
		L	X1,X2
	FI


	LI	X0,YM3B
	EXEC	O3WIB
	ST	X2,YM3BI
	IF
		JUMPE	X2,FALSE
	THEN
		L	X11,[XWD	YM3B+QBL,YM3B]
		BLT	X11,YM3B(X2)
	FI
	RETURN
M3UNR:

;GENERATE UNIQUE NUMBERS IN RADIX 50
;SHOULD BE IN FORM A%BBBB

;COMPUTE A%

	DATE	X0,
	IDIVI	X0,50
	IMULI	X1,50
	ADDI	X1,47	;Radix50 repr. of %
	IMUL	X1,[50*50*50*50]
	ST	X1,Y3UNR1

;COMPUTE BBBB

	MSTIME	X2,
	IDIV	X2,[50*50*50*50]
	ST	X3,Y3UNR2
	RETURN


M3NUNR:

;GENERATE UNIQUE NUMBER = PRECEDING NUMBER +1
;RETURN NUMBER IN X1
;CHECK THAT SECOND CHARACTER = % IS NOT DESTROYED

	AOS	X1,Y3UNR2
	CAML	X1,[50*50*50*50]
	SETZB	X1,Y3UNR2
	ADD	X1,Y3UNR1
	RETURN
	;TABLE CONTAINING ADDRESSES OF ROUTINES TO BE USED AT CURRENT HEADER
M3BL:
	XWD	0,M3CO
	XWD	0,M3IQ
	XWD	0,M3LT
	XWD	0,M3GR
	XWD	0,M3ST
	XWD	0,M3NO

	;BLOCK ITEM TYPE 5
M3BL5:
	XWD	5,2
	XWD	200000,0
	XWD	0

M3BL7:
	XWD	7,1
	XWD	200000,0

		;TABLE OF LEGAL HEADERS IN IC2
M3TYP:
	XWD	0,1013
	XWD	0,10
	XWD	0,1015
	XWD	0,2
	XWD	0,1014
	XWD	0,0
	XWD	0,1010
	XWD	0,1011

M3GL2:
	;HEADER GLOBAL DEF
	XWD	2,4
	BYTE	(4)1,1

M3MAIN:	RADIX50	4,.MAIN
M3MAIL:	RADIX50	4,.MAINL
M3SIML:	RADIX50	4,.SIMLV
M3SIMN:	RADIX50	4,.SIMVL

M3GL:
	0
	;GLOBAL RTS ROUTINES NOT IN LOWSEG
	RTSYMBOLS

	LIT
	END