Directory of image this file is from
This file as a plain text file

/RANRW.SB - RANDOM ACCESS READ/WRITE ROUTINES FOR FORTRAN SABR
/CALL RANW(ID,IREC,VAR)
/IF ID IS THE NEGATIVE OF THE FILE ID, THE BUFFER WILL
/BE FLAGGED AS BEING MODIFIED, AND THE OUTPUT OPERATION
/WILL NOT TAKE PLACE UNTIL THE BUFFER IS NEEDED OR A
/CALL TO RCLOSE IS MADE.
/
/CALL RANR(ID,IREC,VAR)
/TRANSFER RECORD IREC FROM PREVIOUSLY ROPEN'ED FILE
/TO USER CORE STARTING AT VAR. NOTE THAT THE TYPE OF VAR
/IS NOT CRITICAL.
/IF A NON-CORE-RESIDENT HANDLER IS REQUIRED, IT WILL BE LOADED
/AT 01000. THIS AREA IS RESERVED BY LOADER OPTION /I OR /O.
/******* MUST NOT LOAD INTO 10000-11777 IF A NON-CORE-RESIDENT
/HANDLER IS TO BE USED, UNLESS HANDLER IS ALREADY LOADED IN CORE
/BY A PREVIOUS CALL TO CREATE OR ROPEN. IN THIS CASE YOU
/SHOULD NOT USE FORTRAN  DEVICE # 4.
/NOTE WHEN YOU LEAVE THE PROGRAM FOR CHAINING OR EXIT, A CALL
/TO RCLOSE MUST BE MADE, IF YOU USE THE FAST WRITE MODE.
/
/THERE ARE TWO BUFFERS IN THIS SUBROUTINE TO SPEED UP
/WRITE OPERATIONS IN FAST MODE.
/BUFFER ALLOCATION ALGORITHM :
/(1) SEE IF BLOCK CONTAINING RECORD IS IN CORE.
/(2) IF NOT, IS A BUFFER AVAILABLE ? ("BUF MODIFIED FLAG NOT SET)
/(3) IF NOT, USE "OLDEST BUFFER.
/
/THIS PROGRAM IS OPTIMIZED FOR LESS CORE SPACE BY ED SMALLENBURG.
/IT DOES NOT LONGER USE THE MQ-REGISTER TO BE COMPATIBLE
/WITH OLDER PDP8'S.
/
	ENTRY	RANR
	ENTRY	RANW
	ENTRY 	RCLOS
	OPDEF TADI	1400
	OPDEF DCAI	3400
	OPDEF JMSI	4400
	OPDEF JMPI	5400
LAP
BUF1,	0; PAGE; PAGE	/BUFFER 1
BUF2,	0; PAGE; PAGE	/BUFFER 2
/
VARLOC,
RANW,	0		/WRITE ENTRY
WRSW,	0		/WRITE SWITCH
	TAD RANW	/MOVE ENTRY
	DCA RANR	/TO RANR
	TAD RANW#
	DCA RANR#
	JMP RAN1	/NOTE THAT WRSW.NE.0
ERRA,	TEXT "RDWR"
RANR,	BLOCK 2		/READ ENTRY
	DCA WRSW	/CLEAR WRITE SWITCH IF READ
RAN1,	JMS SETUP	/READ CORRECT BLOCK IN CORE
	JMS MOVE	/MOVE RECORD
	TAD WRSW	/CALL TO RANW ?
	SNA CLA
	JMP RANRET	/NO: RETURN
	TAD ID		/POS. ID ?
	SPA CLA
	JMP RAN2	/NO: SET MODFLAG
	TAD CWRITE	/YES: REWRITE BUFFER
	JMS RDWRT
	JMP RANRET	/AND RETURN
RAN2,	TAD 10		/POINTS TO MODFLAG
	DCA RANW	/USE AS TEMP.
	CLA CMA
	DCAI RANW	/SET FLAG
RANRET,	CLA CLL IAC RAL	/FORM CIF CDF
	TAD RANR	/FOR FAST RETURN
	DCA RAN3
ID,
RAN3,	0		/CIF CDF RETURN-FIELD
	JMPI RANR#	/RETURN
/
/
TEMP1,
GETARG,	0		/GET ARGUMENT
	TAD I RANR	/GET FLD OF ARG ADDR
	DCA VARCDF
	INC RANR#	/POINTS TO ADDR.
	TADI RANR#	/GET ADDR
	DCA VARLOC
	INC RANR#	/FOR NEXT CALL
VARCDF,	0		/WILL BE CDF X
	TADI VARLOC	/GET ARGUMENT
	JMP I GETARG	/RETURN
/
SETUP,	0		/GET PARAMETERS, READ BLOCK
	JMS GETARG	/GET ID
	DCA ID
	JMS GETARG	/GET IREC
	DCA IREC
	JMS GETARG	/GET VARLOC AND VARCDF
	CLA CMA		/VAR IS NOT IMPORTANT NOW
	TAD CPNT1	/SET AUTO INDEX FOR BUF1
	DCA 10
	TAD ID
	SPA		/MAKE + ID
	CIA
	SPA SNA		/MUST BE +
	JMP ERR3	/BAD ID
	CLL RTL		/*4
	TAD (-24	/MUST BE 20 OR LESS
	SMA SZA
	JMP ERR3	/BAD ID
	TAD (217	/COMMON ADDR.=(ID*4)+174
	DCA 11		/TO AUTO INDEX
	6211		/CDF 10
	TADI 11		/GET RECORD LENGTH
	DCA RECLEN
	TADI 11		/GET -FILE LENGTH
	DCA FLGTH
	TADI 11		/GET STARTING BLOCK OF FILE
	DCA SBLK
	TADI 11		/GET DEVICE #
	DCA DEV
	JMS COMBLK	/COMPUTE BLOCK # AND RECORD OFFSET
	JMS DECIDE	/BLOCK IN BUFFER 1 ?
	TADI 10		/NO:GET MODFLG 1
	DCA TEMP1	/SAVE IT
	JMS DECIDE	/BLOCK IN BUFFER 2 ?
	TADI 10		/NO: GET MODFLAG 2
	SMA CLA		/2 MODIFIED ?
	JMP TAKE2	/NO: TAKE 2
	TAD TEMP1	/1 MODIFIED ?
	SMA CLA
	JMP TAKE1	/NO: TAKE 1
	TAD PBUF1	/BOTH MODIFIED, USE OLDEST
	CIA
	TAD BUF		/1 LAST USED ?
	SZA CLA		/YES: USE 2
	TAD (-4		/NO: USE 1
	TAD 10
	DCA 10
	TAD CWRITE	/REWRITE OLD BUFFER
	JMS RDWRT
	JMP TAKE2	/TAKE THIS BUFFER
TAKE1,	TAD (-4		/SET POINTER TO CDEV1+3
	TAD 10
	DCA 10
TAKE2,	TAD (-4		/SET POINTER FOR NEW DEVICE,BLK
	TAD 10
	DCA 11
	TAD DEV		/SET DEVICE
	DCAI 11
	TAD BLK		/SET BLOCK
	DCAI 11
	TAD CREAD	/READ NEW BUFFER
	JMS RDWRT
SET2,	JMPI SETUP	/RETURN
/
IREC,	0		/RECORD #
RECLEN,	0		/RECORD LENGTH
FLGTH,	0		/-FILE LENGTH
SBLK,	0		/STARTING BLOCK #
DEV,	0		/DEVICE NUMBER
BLK,	0		/ABS. BLOCK #
CPNT1,	CDEV1		/POINTER TO BUFFER-CONTROL-WORDS
PBUF1,	BUF1		/POINTER TO BUF1
CREAD,	1777		/4200-6201
CWRITE,	5777		/0200-6201
/
PAGE
/
DECIDE,	0		/CHECK IF BUFFER IS IN CORE
	TADI 10		/DEVICE FOR THIS BUFFER
	CIA
	TADI DEVI	/REQESTED DEVICE
	DCA TEMP2
	TADI 10		/BLOCK # FOR THIS BUFFER
	INC 10		/POINTS TO MODFLAG NOW
	CIA
	TADI BLKI#	/REQUESTED BLOCK
	SZA CLA		/SAME ?
	JMP I DECIDE	/NO: RETURN
	TAD TEMP2	/DEVICE THE SAME ?
	SZA CLA
	JMPI DECIDE	/NO: RETURN
	ISZ 10		/POINTS TO BUFFER ADDR NOW
	JMP SET2	/BUFFER IS IN CORE
/
TEMP2,
COMBLK,	0		/COMPUTE BLOCK & RECORD OFFSET
	TAD (400	/BLOCK LENGTH
	CALL 1,DIV
	ARG RECLEN
	DCAI BLKI#	/RECORDS PER BLOCK
	CLA CMA	/REL. BLOCK= (REC-1)/(RECORDS PER BLOCK)
	TAD IREC
	SPA		/MUST BE +
	JMP ERR2	/BAD RECORD #
	CALL 1,DIV
BLKI,	ARG BLK
	DCAI BLKI#	/REL. BLOCK
	TADI BLKI#
	TADI FLGTHI	/CHECK IF INSIDE FILE
	SMA SZA CLA
	JMP ERR2	/OUTSIDE OF FILE
	TADI BLKI#
	TADI SBLKI
	DCAI BLKI#
	CALL 0,IREM
SBLKI,	SBLK		/DUMMY ARG TOO
DEVI,	DEV		/
	CALL 1,MPY
	ARG RECLEN
	DCA OFFS	/SAVE OFFSET IN BLOCK
	JMPI COMBLK	/RETURN
/
FLGTHI,	FLGTH
USR,	7700
RDWRT,	0		/READ OR WRITE BUFFER
	TAD BLKI	/FORM FUNCTION
	DCA RW3
	TAD (-4		/SET POINTER TO DEV
	TAD 10
	DCA 10
	TADI 10		/GET DEVICE #
	DCA RW4
	TAD RW4
	TAD (7646	/RESIDENCY TABLE-1
	DCA FET1
	6211		/CDF 10
	TADI FET1	/HANDLER ENTRY
	JMS MYCDF	/RESET DF
	SZA		/FETCH HANDLER IF NOT IN CORE
	JMP RW7		/IN CORE ALLREADY
	TAD (1001	/HANDLER INTO 01000
	DCA FET1
	TAD RW4		/DEV.#
	6212		/CIF 10
	JMSI USR
	 1		/FETCH
FET1,	 0		/WILL BE ENTRY
	JMP ERR1	/FETCH ERROR
	SKP CLA
RW7,	DCA FET1	/STORE HANDLER ENTRY
	TADI 10		/GET BLOCK #
	DCA RW4
	TADI 10		/GET BUFFER ADDRESS
	DCA BUF
	6202		/CIF 0
	JMSI FET1	/CALL HANDLER
RW3,	 0		/FUNCTION
BUF,	 0		/BUFFER ADDRESS
RW4,	 0		/BLOCK #
	JMP ERR1	/READ/WRITE ERROR
	TAD RW3		/WAS IT A WRITE ?
	SMA		/YES: CLEAR MODFLAG
	INC 10
	SPA CLA
	DCAI 10		/CLEAR MODFLAG
	JMPI RDWRT	/RETURN
/
OFFS,	0		/OFFSET IN BLOCK
MYCDF,	0		/CHANGE TO CURRENT DATAFIELD
	JMP I MYCDF	/THAT'S ALL
PAGE
MOVE,	0		/MOVE DATA TO OR FROM VAR
	CLA CLL CMA RAL	/AC=-2
	TAD 10
	DCA 11		/POINT TO RIGHT BUFFER
	TADI WRSWI
	SNA CLA		/READ OR WRITE ?
	JMP MOVR	/READ
	CLA CMA
	TADI 11		/COMPUTE DEST. POINTER
	TADI OFFSI
	DCA 12
	CLA CMA
	TADI VARLOI	/SET SOURCE POINTER
	DCA 11
	TADI VARCDI	/SET SOURCE FIELD
	DCA MOV1
	TAD CDC3	/SET DEST FIELD
MOV3,	DCA MOV2
	TADI RECLEI	/SET TALLY
	CIA
	DCA MOV4
MOV1,	0		/CDF SOURCE
	TADI 11
MOV2,	0		/CDF DEST.
	DCAI 12
	ISZ MOV4	/READY ?
	JMP MOV1	/NO
CDC3,	JMP I MOVE	/RETURN

MOVR,	CLA CMA
	TADI 11		/COMPUTE SOURCE POINTER
	TADI OFFSI
	DCA 11
	CLA CMA
	TADI VARLOI	/SET DEST POINTER
	DCA 12
	TAD CDC3	/SET SOURCE FIELD
	DCA MOV1
	TADI VARCDI	/SET DEST. FIELD
	JMP MOV3
/WRITE BUFFER IS MODFLAG IS SET
RCLOS,	BLOCK 2		/ENTRY RCLOSE
	CLA CMA
	TAD CPNTB	/ASSUME BUF 1 MUST BE WRITTEN
	DCA 10
	TAD CMOD1	/WRITE BUF1 ?
	SNA CLA
	JMP RCL2	/NO
	TAD CWRT2
	JMS RDWRT	/REWRITE
	JMP RCL3
RCL2,	CLA CLL IAC RTL	/ASSUME BUF 1 MUST BE WRITTEN
	TAD 10
	DCA 10
RCL3,	TAD CMOD2
	SNA CLA
	JMP RCL4	/NO
	TAD CWRT2
	JMS RDWRT
RCL4,	CLA CLL IAC RAL	/FAST RETURN RCLOS
	TAD RCLOS
	DCA RCL5
RCL5,	0		/CIF CDF RETURN FIELD
	JMPI RCLOS#	/RETURN
/ERROR MESSAGES
/
ERR2,	CLA CLL
	TAD ERRB
	DCA ERRA
	TAD ERRB#
	DCA ERRA#
	JMP ERR1
ERR3,	CLA CLL
	TAD ERRC
	DCA ERRA
	TAD ERRC#
	DCA ERRA#
ERR1,	CLA CLL
	CALL 1,ERROR
	ARG ERRA		/ALL ERRORS ARE FATAL
ERRB,	TEXT "RECN"
ERRC,	TEXT "FID "
MOV4,	0		/TALLY FOR MOVE
WRSWI,	WRSW
OFFSI,	OFFS
VARLOI,	VARLOC
VARCDI,	VARCDF
RECLEI,	RECLEN
CWRT2,	5777
CPNTB,	CDEV2
/BUFFER CONTROL WORDS
CDEV1,	0
CBLK1,	0
CBUF1,	BUF1
CMOD1,	0
CDEV2,	0
CBLK2,	0
CBUF2,	BUF2
CMOD2,	0
/
PAGE
END