Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/f40opn.txt
There are 2 other files named f40opn.txt in the archive. Click here to see a list.
	SUBTTL	FX1 V.27	17-JULY-74
	;UPDATE IF COMPILER IS CHANGED
	LEVEL	O,27,,26	;##### UPDATE IF COMPILER CHANGES ;"27A"
>
IFN FTMANT,<
	LEVEL	0,27,U,26	;##### UPDATE IF COMPILER CHANGES ;"23-AU"
>
;** EDIT 27M  	PAGE2 OF FX1	ILG	24-JUL-74
	EXTERNAL	 ARGNUM,ARGTLY,NULDIA,ARGMAP,TXLST,ARGKNT;[27M]
	EXTERNAL	UNIDEF,SPSW,CLODEF,OPNDEF		;[27M]
	EXTERNAL	MULRET					;[27M]
;** EDIT 27M		SSABLT+1	(PG.70 FX1)	ILG	18-JUL-74
; FAKE A SYMBOL SCAN FOR THE APPROPRIATE ROUTINE
REGCLS:	SKIPA	%07,[SIXBIT/CLS40./]	;[27M]REGISTER A CLOSE
REGOPN:	MOVE	%07,[SIXBIT/OPN40./]	;[27M]AN OPEN
	MOVEM	%07,SYMBOL+ZZ		;[27M]STORE IT
	SETZM 	ARGKNT+ZZ		;[27M] ZERO SOME STUFF
	SETZM	ARGMAP+ZZ		;[27M]
	SETZM	ARGTLY+ZZ		;[27M]
	SETZM 	UNIDEF+ZZ		;[27M]
	AOJA	%01,PSEML		;[27M] AND DO NEXT POP
;  STORE AN ARGUMENT NUMBER FOR LATER CODE GENERATION AND
; INSURE AGAINST DUPLICATE STUFF
NXTARG:	MOVE 	%10,ARGKNT+ZZ		;[27M] COUNTER OF ARGS
	MOVE 	%07,ARGNUM+ZZ		;[27M]THIS ARG IS #
	MOVEM	%07,TXLST-1+ZZ(%10)	;[27M]STORE IT
	MOVEI	%10,1			;[27M] MODIFY BITMAP
	LSH	 %10,(%07)		;[27M]IN PROPER POSITION
	EXCH	%10,ARGMAP+ZZ		;[27M]
	TDON	%10,ARGMAP+ZZ		;[27M]
	TDZA	%03,%03			;[27M] FALSE RETURN
	SETOM	%03			;[27M]TRUE RETURN
	MOVEM	%10,ARGMAP+ZZ		;[27M] STORE MAP
	AOJA	%01,PSEML		;[27M]DO NEXT POP
; ON EACH CALL GET A NUMBER OF AN ARGUMENT AND RETURN TO ARGNUM
FETARG:	AOS	%07,ARGTLY+ZZ		;[27M]UP COUNTER
	MOVE %07,TXLST-1+ZZ(%07)	;[27M] GET THE NUMBER
	MOVEM	%07,ARGNUM+ZZ		;[27M]STASH IT
	AOJA	%01,PSEML		;[27M]DONE
RELML:					;;RELEASE ML
;** EDIT 27M	CSTXLA	(PG. 54 FX2)	ILG	18-JUL-74
;[27M]	FEX	(COSTXL)	;CONTINUE STA XLATE
	FEX	(OPSTXL)	;[27M]OPEN STATEMENT TRANSLATE
	ZER	(SPSW)		;[27M]INSURE ITS OFF
	QSF	(CALQT)		;CALL QT
	JSB	(IDSCAN)	; ID SCAN
CSTCNT:	JSBF	(RGLSPR)	;;[27M]REGISTER GLOBAL SPROG
	SMK	(GSPEM)	;GLOBAL SPROG EM
;** EDIT 27M	CSTXLA+20.	(PG.54 FX2)	ILG	19-JUL-74
	ZER	(SPSW)		;[27M]SPECIAL SWITCH OFF
	JMP	(ACEOEX)	;ACTIVE EOL EXIT
;** EDIT 27M	COSTXL-1	(PG.54 FX2)	ILG	18-JUL-74
OPSTXL:	FEX	(CLSTXL)	;[27M] CLOSE STATEMENT XLATE
	QSF	(OPNQT)		;[27M] OPEN QUOTE
	NOZ	(OPNDEF)	;[27M]
	JSB 	(IDSCAN)	;[27M] SCAN FAKE 'OPEN' SYMBOL
	ZER 	(OPNDEF)	;[27M]
	NOZ	(SPSW)		;[27M] ARGUMENT SWITCH
	JMP 	(CSTCNT)	;[27M] AND CONTINUE
CLSTXL:	FEX	(COSTXL)	;[27M] CONTINUE STATEMENT TRANSLATE
	QSF	(CLSQT)		;[27M] CLOSE QUOTE
	NOZ 	(CLODEF)	;[27M] TURN FAKE ID ON
	JSB	(IDSCAN)	;[27M] SCAN IT
	ZER	(CLODEF)	;[27M] ZERO SWITCH
	NOZ	(SPSW)		;[27M] ON WITH SPECIAL SWITCH
	JMP 	(CSTCNT)	;[27M] CONTINUE
COSTXL:				;CONTINUE STA XLATE
	FEX	(TSTXLA)	;TYPE STA XLATE
	ZER	(SPSW)		;[27M] IF WE ARE HERE, THEN DEFINITELY NOT O/C
	QSF	(CONQT)		; CONTINUE QT
;** EDIT 27M	SASXLI+2 (PG.83 FX2)	ILG	19-JUL-74
	SNZ	(SPSW)		;[27M] DOING AN OPEN OR CLOSE?
	JMPT	(OCARG)		;[27M] YES, GO CLASSIFY THE TYPE
CTRCAL:	
	CSA	(DOLLAR)	;$?"22A"
;** EDIT 27M	AREXLA-1	(PG.83 FX2)	ILG	19-JUL-74
OCARG:	ZER	(ARGNUM)	;[27M] ZERO FOROTS O/C ARG#
	ZER	(NULDIA)	;[27M] AND DIALOG W/NULL ARG
	QSA	(UNITQT)	;[27M] IS IT UNIT NUMBER?
	NOZT	(UNIDEF)	;[27M] YES, MARK AS DEFINED
	JMPT	(OCBCK)		;[27M] AND GO BACK
	TLY	(ARGNUM)	;[27M]DIALOG= IS FOROTS ARG 1
	QSA	(DIALQT)	;[27M]CHK IT
	JMPF	(SACC)		;[27M] NO,SEE IF ACCESS
	CSA 	(EQUAL)		;[27M]IS IT NULL ARGUMENT?
	FETF	(CZEPNT)	;[27M]GIVE IT A ZERO ARGUMENT
	NOZF	(NULDIA)	;[27M] AND MARK IT
OCBCK:
	TLY	(ARGKNT)	;[27M] UP THE ARGUMENT COUNT
	XML	(NXTARG)	;[27M] REGISTER IT
	LCFT	(M25QT)		;[27M] IF A DUPLICATE
	FET	(ARGKNT)	;[27M] IF FIRST VALID ARG
	SEQ	(ONE)		;[27M] THEN CLEAR
	RELT	(ERRROL)	;[27M] THE ERROR ROLL
	SNZ	(NULDIA)	;[27M]IF NULL DIALOG
	JMPT	(SASXL4)	;[27M] WE HAVE OUR ARGUMENT
	JMP 	(CTRCAL)	;[27M] BACK TO PROCESS REAL ARG
SACC:	TLY	(ARGNUM)	;[27M] UP ARGUMENT COUNTER
	QSA	(ACCSQT)	;[27M] ACCESS?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(DEVQT)		;[27M]DEVICE?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(BUFFQT)	;[27M] BUFFER COUNT?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(BLSZQT)	;[27M] BLOCK SIZES?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA 	(FILEQT)	;[27M] FILE NAME?
	JMPT 	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(PROTQT)	;[27M] PROTECTION?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(DIREQT)	;[27M] DIRECTORY?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(LIMQT)		;[27M] LIMIT?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(MODEQT)	;[27M] MODE?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(FLSZQT)	;[27M] FILESIZE?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(RCSZQT)	;[27M] RECORD SIZE?
	JMPT	(OCBCK)		;[27M] YES
	TLY 	(ARGNUM)	;[27M] NO
	QSA	(DISPQT)	;[27M] DISPOSE?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(VERQT)		;[27M] VERSION ?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(REELQT)	;[27M] REELS?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(MOUQT)		;[27M] MOUNT?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(ERR2QT)	;[27M] ERROR=
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(ASVAQT)	;[27M] ASSOCIATE VARIABLE?
	JMPT	(OCBCK)		;[27M] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(PARQT)		;[27M] PARITY?
	JMPT	(OCBCK)		;[27J] YES
	TLY	(ARGNUM)	;[27M] NO
	QSA	(DENSQT)	;[27M] DENSITY?
	JMPT	(OCBCK)		;[27M] YES
	LCF	(M26QT)		;[27M] NOT RECOGNIZED
	JMP	(OCBCK)		;[27M] BACK
AREXLA:				; ARRAY REF XLATE
;** EDIT 27M	SREGE1+3  (PG.111 FX2)  ILG	19-JUL-74
	SNZ	(SPSW)		;[27M] DOING AN OPEN/CLOSE?
	JSBT	(ARGPRO)	;[27M] YES, DO PROLOG FOR O/C ARGS
	SMK 	(MLBEM)		;MAKE LBL EM
;** EDIT 27M	SREGE1+9. (PG. 111 FX2)		ILG	22-JUL-74
ARGPRO:
	SNZ	(UNIDEF)	;[27M] MAKE SURE UNIT DEFINED
	LCFF	(M27QT)		;[27M] ITS NOT
	XML	(FETARG)	;[27M] GET ARGUMENT TYPE
	FET	(RZEPNT)	;[27M] REG PTR FOR INST. ADDR
	FET 	(RZEPNT)	;[27M] GOES AS INST. ADDR
	ADD	(ARGNUM)	;[27M]
	BIN	(.ARG0)		;[27M] GENERATE PAIR PROLOG
	POW	(D1)		;[27M] AND GET WORD OFF WORK
	XIT	(EXIML)		;[27M] BACK FOR ARG
SAEXGE:				;SPROG ADDRESS EXPRESSION GEN

;** EDIT 27M	IDSCAN	(PG.122 FX2)	ILG	18-JUL-74
;[27M]	JSB	(SYMSCA)	;SYMBOL SCAN
	SNZ	(OPNDEF)	;[27M]  IS IT AN OPEN?
	SNZF	(CLODEF)	;[27M] OR A CLOSE?
	JSBF	(SYMSCA)	;[27M] NO
	JMPF	(IDCLAS)	;[27M] SO DO AS NORMAL
	SNZ	(OPNDEF)	;[27M] IS IT OPEN?
	XMLT	(REGOPN)	;[27M] YES, REGISTER 'OPEN'
	XMLF	(REGCLS)	;[27M] NO, REGISTER 'CLOSE'
IDCLAS:				; ID CLASSIFY
;** EDIT 27M		SKIQPT+1	(PG.2 FX3)	ILG	18-JUL-74
OPNQT:
	QT	OPEN
CLSQT:	QT	CLOSE
; [27M] THIS NEXT SECTION IS THE ARGUMENTS THAT OPEN/CLOSE CAN TAKE
UNITQT:	QT	UNIT=
DEVQT:	QT	DEVICE=
ACCSQT:	QT	ACCESS=
MODEQT:	QT	MODE=
DISPQT:	QT	DISPOSE=
FILEQT:	QT	FILE=
PROTQT:	QT	PROTECTION=
DIREQT:	QT	DIRECTORY=
BUFFQT:	QT	BUFFERCOUNT=
FLSZQT:	QT	FILESIZE=
VERQT:	QT	VERSION=
BLSZQT:	QT	BLOCKSIZE=
RCSZQT:	QT	RECORDSIZE=
ASVAQT:	QT	ASSOCIATEVARIABLE=
PARQT:	QT	PARITY=
DENSQT:	QT	DENSITY=
DIALQT:	QT	DIALOG
ERR2QT:	QT	ERROR=
LIMQT:	QT	LIMIT=
REELQT:	QT	REEL=
MOUQT:	QT	MOUNT=
RECQT:
;** EDIT 27M		ERROR MESSAGES (PG 6 FX3)	ILG	19-JUL-74
	MSGQT	M,25,DUPLICATE ARGUMENT IN OPEN/CLOSE STATEMENT,	;[27M]
	MSGQT	M,26,NOT A RECOGNIZED ARGUMENT TO OPEN/CLOSE,	;[27M]
	MSGQT	M,27,UNIT IS A REQUIRED ARGUMENT FOR OPEN/CLOSE,  ;[27M]
	MSGQT	I,1,DUPLICATED DUMMY VARIABLE IN ARGUMENT STRING
;** EDIT 27M			PAGE 1 OF FX4		ILG	24-JUL-74
	INTERNAL	OPNDEF,CLODEF,SPSW,ARGNUM,ARGTLY,NULDIA ;[27M]
	INTERNAL	ARGMAP,TXLST,ARGKNT,UNIDEF
	EXTERNAL	ASCIBL,PDPSET
;
;** EDIT 27M	LSPDEF+1	(PG.6 FX4)	ILG	18-JUL-74
OPNDEF:	BLOCK 	1	;[27M] DEFINING AN OPEN
CLODEF:	BLOCK	1	;[27M] DEFINING A CLOSE
SPSW:	BLOCK	1	;[27M] DOING SPECIAL ARGUMENT TRANSLATION
ARGNUM:	BLOCK	1	;[27M] SPECIAL FOROTS OPEN/CLOSE ARG #
ARGTLY:	BLOCK	1	;[27M] OPEN/CLOSE BOOKEEPING
NULDIA:	BLOCK	1	;[27M] INDICATES DIALOG ARG W/NO ARG
ARGMAP:	BLOCK	1	;[27M] BIR MAP USED FOR CHECK ON DUPLICATE ARGS
TXLST:	BLOCK	25	;[27M] FOR EACH O/C ARG, ITS FOROTS ARG ID
ARGKNT:	BLOCK	1	;[27M] O/C BOOKKEEPING
UNIDEF:	BLOCK	1	;[27M] NON ZERO IF UNIT DEFINED
; THE FOLLOWING ASSIGNMENTS - THROUGH DAT4 - SHOULD NOT BE SEPARATED