Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - forrms.mac
There are 7 other files named forrms.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORRMS	RMS INTERFACE, 10(4131)

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

4065	JLC	6-Dec-83
	Added some new entries for the skeleton.

4066	JLC	11-Jan-84
	More new entries for the skeleton.

4072	JLC	24-Jan-84
	Begin coding.

4102	JLC	17-Feb-84
	Remove a global which was removed from FOROPN.

4122	JLC	2-May-84
	Add some more globals.

4131	JLC	12-Jun-84
	Add non-skip memory full return to %GTBLK call.

***** End V10 Development *****

***** End Revision History *****
\

	SEARCH	RMSINT

	ENTRY	%IRMS,%ORMS,%RMOPN,%RMLKP,%RMRFS
	ENTRY	%RMOSW,%RMISW,%RMCLS,%RMREW,%RMBSR,%RMEND
	ENTRY	%RMSIN,%RMSOU,%RMRDW,%RMSKR,%RMSTR
	ENTRY	%RMREN,%RMDSP

	EXTERN	%GTFNS,%TXTBF,%GTBLK

	SEGMENT	CODE

;%IRMS - READ A RECORD WITH RMS.
%IRMS:	POPJ	P,

;%ORMS - WRITE A RECORD WITH RMS.
%ORMS:	POPJ	P,

;%RMLKP - LOOKUP AN RMS FILE
%RMLKP:	POPJ	P,

;%RMRFS - RETURN RMS FILESPEC TO DDB VARIABLES
%RMRFS:	POPJ	P,

;%RMOPN - OPEN AN RMS FILE

IF10,<
%RMOPN:	POPJ	P,
> ;END IF10

IF20,<
%RMOPN:	MOVEI	T1,FA$LNG	;GET A FAB-LENGTH BLOCK
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;[4131] CAN'T
	MOVEM	T1,FAB(D)	;SAVE ITS ADDRESS
	FAB$B	(T1)		;DECLARE IT
	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO TEXT BUFFER
	PUSHJ	P,%GTFNS	;GET FILENAME STRING
	F$FNA	%TXTBF		;POINT TO IT

	LOAD	T1,ORGAN(D)	;GET ORGANIZATION
	MOVE	T1,ORGTAB(T1)	;GET ORG BITS
;	F$ORG	(T1)		;SET THEM
	MOVE	T1,RECTP(D)	;GET RECORD TYPE
	MOVE	T1,RTTAB(T1)	;GET RECORD TYPE BITS
;	F$RFM	(T1)		;SET RECORD TYPE FIELD
	FAB$E			;END FAB INITIALIZATION

	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	PUSHJ	P,RMOTB(T1)	;OPEN THE FILE
	POPJ	P,

ORGTAB:	FB$SEQ			;SEQUENTIAL
	FB$REL			;RELATIVE
	FB$IDX			;INDEXED

RTTAB:	FB$STM			;UNDEFINED
	FB$FIX			;FIXED
	FB$VAR			;VARIABLE
	FB$STM			;SEGMENTED

RMOTB:	JRST	RMOUR		;UNKNOWN, READ
	JRST	RMOUW		;UNKNOWN, WRITE
	JRST	RMOURW		;UNKNOWN, READ, WRITE
	JRST	RMOUA		;UNKNOWN, APPEND
	JRST	RMOOR		;OLD, READ
	JRST	RMOORW		;OLD, WRITE
	JRST	RMOORW		;OLD, READ, WRITE
	JRST	RMOOA		;OLD, APPEND
	JRST	RMONW		;NEW, WRITE
	JRST	RMOUW		;NEW, SCRATCH

RMOUR:;	F$FAC	FB$NIL
;	F$FOP	FB$CIF		;CREATE IF NOT THERE ALREADY
;	F$SHR	FB$GET		;ALLOW OTHER USERS TO READ IT
;	FAB$E			;END OF FAB

	$CREATE	@FAB(D),RMOERR	;OPEN OLD OR CREATE NEW
	POPJ	P,

RMOUW:;	F$FAC	FB$DEL!FB$UPD!FB$TRN!FB$PUT!FB$GET
;	F$FOP	FB$SUP		;CREATE NEW GENERATION
;	FAB$E			;END FAB

	$CREATE	@FAB(D),RMOERR	;CREATE NEW FILE

;IF THIS PRODUCES AN ERROR, BECAUSE, IN FACT, RMS HAS
;GJ%FOU+GJ%NEW SET, WE MUST CHECK IF THE CODE RETURNED
;INDICATES THE $CREATE FAILED BECAUSE THE FILE ALREADY
;EXISTS. IF THIS IS THE CASE, WE SHOULD BACK OUT OF THE
;FB$SUP AND USE $OPEN TO OPEN THE EXISTING GENERATION.

	POPJ	P,

RMOURW:;	F$FAC	FB$DEL!FB$UPD!FB$TRN!FB$PUT!FB$GET
;	F$FOP	FB$CIF		;OPEN OLD OR CREATE NEW
;	FAB$E			;END OF FAB PROCESSING

	$CREATE	@FAB(D),RMOERR	;CREATE THE NEW FILE
	POPJ	P,

RMOOR:;	F$FAC	FB$NIL
;	FAB$E			;END FAB

	$OPEN	@FAB(D)		;OPEN OLD FILE
	POPJ	P,

RMOORW:;	F$FAC	FB$DEL!FB$UPD!FB$TRN!FB$PUT!FB$GET
;	FAB$E			;END FAB

	$OPEN	@FAB(D)		;OPEN OLD FILE, WRITE OVER IT
	POPJ	P,

RMOOA:
RMOUA:	POPJ	P,		;DON'T KNOW HOW TO OPEN APPEND YET

RMONW:;	F$FAC	FB$DEL!FB$UPD!FB$TRN!FB$PUT!FB$GET
;	FAB$E			;END FAB

	$CREATE	@FAB(D),RMOERR	;CREATE NEW FILE
	POPJ	P,

RMOERR:	POPJ	P,		;HAVE TO DECODE THE ERROR CODE SOMEHOW!

> ;END IF20

;%RMISW - SWITCH A FILE FROM OUTPUT TO INPUT
%RMISW:	POPJ	P,

;%RMOSW - SWITCH A FILE FROM INPUT TO OUTPUT
%RMOSW:	POPJ	P,

;%RMCLS - CLOSE A FILE
%RMCLS:	POPJ	P,

;%RMREN - RENAME A FILE
%RMREN:	POPJ	P,

;%RMDSP - DISPOSE OF A FILE (NOTHING,PRINT,PUNCH,SUBMIT)
%RMDSP:	POPJ	P,

;%RMREW - REWIND A FILE
%RMREW:	POPJ	P,

;%RMBSR - BACKSPACE ONE RECORD
%RMBSR:	POPJ	P,

;%RMEND - END FILE
%RMEND:	POPJ	P,

%RMSIN:	POPJ	P,

%RMRDW:	POPJ	P,

%RMSOU:	POPJ	P,

%RMSKR:	POPJ	P,

%RMSTR:	POPJ	P,

	END