X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Frsw.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Frsw.ra;h=d824a4ffb90699682b4b74ccdc3559140ed2f0a7;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/os8/v3d/sources/fortran/all/rsw.ra b/sw/os8/v3d/sources/fortran/all/rsw.ra
new file mode 100644
index 0000000..d824a4f
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/all/rsw.ra
@@ -0,0 +1,141 @@
+/
+/ VERSION 5A 4-26-77 MH
+/
+/THE FOLLOWING IS A SET OF 8 MODE (RALF TYPE)
+/ROUTINES THAT ENABLE PDP 12(8) HARDWARE OPTIONS
+/THESE ROUTINES ARE CALLABLE AT THE FORTRAN LEVEL
+/THE FOLLOWING OPTIONS ARE SUPPORTED:
+/
+/	1 READ A BIT IN THE RIGHT SWITCHES
+/	2 READ A BIT IN THE LEFT SWITCHES
+/	3 READ A SENSE SWITCH
+/	4 READ AN EXTERNAL LEVEL
+/	5 OPEN OR CLOSE A RELAY
+/
+/IF THE REQUESTED BIT OR SWITCH IS SET THE
+/SUBROUTINE RETURNS WITH THE CALLERS ARG SET TO
+/A 1,OTHERWISE IT IS SET TO A 0
+/
+/
+	SECT8 RSW
+	INDEX P17
+	BASE 0
+	JSA SETUP	/CHECK ONE RSW BIT
+	TRAP4 DORITE	/CALL 8 MODE ROUT USER
+			/ARG IS IN FPP XR3
+CONT,	STARTD		/ANSWER IS IN XR3
+	FLDA% 0,XR2	/GET PTR TO CALLER ANS
+	FSTA 3
+	STARTF
+	XTA XR3
+	FSTA% 3		/GIVE ANS TO CALLER
+GOBAK,	FLDA 30		/RTN TO CALLER
+	JAC
+	ENTRY LSW
+LSW,	JSA SETUP	/READ 1 LSW BIT
+	TRAP4 DOLEFT	/CALL 8MODE ROUT
+	JA CONT
+	ENTRY SSW
+SSW,	STARTD		/READ A SENSE SWITCH
+	FLDA ANSNSI
+	JA ESSW
+	ENTRY ROPEN
+ROPEN,	STARTD		/OPEN A RELAY
+	FLDA ABCLI
+ERCLOS,	FSTA MASK	/PLANT A BCLI OR BSEI IN
+			/8 MODE ROUTINE
+	JSA SETUP
+	TRAP4 RELAY
+	FLDA 30
+	JAC
+	ENTRY EXTLVL
+EXTLVL,	STARTD		/READ AN EXTERNAL LEVEL
+	FLDA ANSXL
+ESSW,	FSTA LSKP	/PLANT SXLI OR SNS IN
+	JSA SETUP	/8 MODE ROUTINE
+	TRAP4 DOSXL
+	JA CONT
+	ENTRY RCLOSE
+RCLOSE,	STARTD		/CLOSE A RELAY
+	FLDA ABSEI
+	JA ERCLOS
+SETUP,	0;0		/GET ARGS AND SETUP RTN
+	STARTD
+	SETX P17
+	FLDA% 0,XR1	/GET PTR TO 1ST USER ARG
+	FSTA 3
+	STARTF
+	FLDA% 3		/USER ARG TO FAC
+	ATX XR3		/PUT IN XR FOR 8 MODE
+	JA SETUP
+DORITE,	0		/READ RIGHT SWITCHES
+	LAS
+	DCA MASK
+	JMS SETBIT	/GET REQUESTED BIT
+	AND MASK	/MASK RSW
+	SZA CLA		/IF BIT IS SET,SET XR3=1
+	ISZ XR3
+	CIF CDF		/RTN TO RTS
+	JMP% DORITE
+DOLEFT,	0		/READ LEFT SWITCHES
+	TAD DOLEFT
+	DCA DORITE
+	IOF
+	6141		/LINC
+	517		/LSW
+	2		/PDP
+	ION
+	JMP DORITE+2
+DOSXL,	0		/READ SENSE SWITCH
+			/OR EXTERNAL LEVEL
+	TAD XR3		/=SSW OR LVL TO DO
+	AND P17
+	TAD LSKP
+	DCA LSKP
+	CLL CML		/SET LNK=COND MET
+	IOF
+	6141
+LSKP,	0		/=SNS I N OR SXL N
+	261		/IF SKP FAILS THEN COND
+			/IS MET SO ROTATE LNK
+			/INTO AC(11) (261=ROL I 1)
+	2		/PDP
+	ION
+	DCA XR3		/SAVE ANSWER
+	CIF CDF
+	JMP% DOSXL	/RTN TO RTS
+RELAY,	0		/OPEN A RELAY
+	TAD CONT	/=6
+	JMS SETBIT	/GO SET RELAY BIT
+	DCA MASK+1
+	IOF
+	6141
+	15		/GET RELAYS
+MASK,	0		/BCL I OR BSE I
+	0		/SET OR CLR 1 RELAY BIT
+	14		/ATR PUT RELAYS BACK
+	2
+	ION
+	CLA
+	CIF CDF
+	JMP% RELAY
+SETBIT,	0		/COME HERE TO POSITION
+	TAD XR3		/BIT IN AC ACCORDING TO
+			/C(AC)+XR3
+	CMA CLL CML	/ROTATE BIT INTO POSITION
+	DCA XR3		/XR3 MUST=0 UPON EXIT
+	RAR		/ROTATE LINK UNTIL
+	ISZ XR3		/XR3=0
+	JMP .-2
+	JMP% SETBIT	/RTN WITH AC SET
+ABCLI,	1560		/BCL I
+ABSEI,	1620		/BSE I
+P17,	17		/FPP XR0
+XR1,	1
+XR2,	2
+XR3,	0
+ANSXL,	400		/SXL
+	261		/ROL I 1
+ANSNSI,	460		/SNS I
+	261
+