Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/v1b.mac
There are 2 other files named v1b.mac in the archive. Click here to see a list.
00100		SUBTTL	STPPN and PPNST simulation for TOPS-20 v1B
00200		SALL
00300		SEARCH SIMMAC
00400		CTITLE V1B    Adaption for SIMULA to work on TOPS-20 v1B
00500		MACINIT
00600		TWOSEG
00700		RELOC 400K
00800	
00900	Comment;
01000	
01100	Purpose
01200	-------
01300	In TOPS-20 version 2, some JSYS codes have  been  eliminated,  a  few
01400	have  been  changed  (new  input or output), and a few new codes have
01500	been implemented. Some of the new JSYS codes have been implemented in
01600	a  reasonable  way for TOPS-20 release 1B, which is the first release
01700	on which SIMULA can run. SIMULA was however developed for release  2.
01800	This  module is intended to bridge the differences between v1B and v2
01900	of TOPS-20.
02000	
02100	The JSYS codes involved are:
02200	
02300	RCDIR	(recognize  directory). This works in v1B but gives an 18-bit
02400	        directory number only.
02500	
02600	DIRST	(directory  number  to  string). Gives full "STR:<DIRECTORY>"
02700	        string on v2, only "DIRECTORY" on 1B.
02800	
02900	PPNST	(ppn to string). This is a temporary JSYS intended  only  for
03000		DEC use. In v1B, PPNST is a dummy (does nothing).
03100	
03200	STPPN	(string to ppn). Reverse of PPNST. No function on v1B.
03300	
03400	STDIR	(string to directory). Illegal on v2. Replaced by RCDIR.
03500	
03600	This module contains  routines  to  simulate  the  proper  version  2
03700	function  of  DIRST,  PPNST, STPPN. RCDIR is already used in the code
03800	instead of STDIR.
03900	;
04000	
04100		ENTRY V1BINI,DIRST.,PPNST.,STPPN.
04200	
04300		IFNDEF PPNST,<
04400		OPDEF PPNST [JSYS 557]
04500		OPDEF STPPN [JSYS 556]	>
04600	
04700		EXTERN .JBOPS
04800		OPDEF IFV1B [SKIPGE .JBOPS]
     
00100		SUBTTL	V1BINI, initialize flag for V1B of TOPS-20
00200	
00300	Comment;
00400	
00500	Purpose
00600	-------
00700	Finds  out if 18- or 36-bit directory numbers are used. .JBOPS is set
00800	negative if 18-bit numbers are used, i e the TOPS-20  1B  monitor  is
00900	running.   This  means  that  DIRST,  STPPN  and  PPNST  are  treated
01000	specially.
01100	
01200	Function
01300	--------
01400	Use  RCDIR to find the directory number for <SUBSYS>. If left half of
01500	the directory number returned is not zero,  set  .JBOPS  negative.  A
01600	smarter method can certainly be found!
01700	;
01800	
01900	V1BINI:	PROC
02000		SAVE <X1,X2,X3>
02100		EXCH .JBOPS
02200		TLO (1B0)
02300		MOVSI X1,(RC%EMO)	;No recognition (Exact Match Only)
02400		HRROI X2,[ASCIZ/<SUBSYS>/]
02500		RCDIR
02600		 ERJMP L9
02700		TLNE X3,-1
02800		 TLZ (1B0)
02900	L9():!	EXCH .JBOPS
03000		RETURN
03100		EPROC
     
00100		SUBTTL	DIRST. Directory number to string
00200	
00300	Comment;
00400	
00500	Purpose
00600	-------
00700	Simulate v2 action of DIRST JSYS.
00800	
00900	Input
01000	-----
01100	X1:	Output designator.
01200	X2:	Directory number.
01300	
01400	Output
01500	------
01600	STR:<DIRECTORY> in output string. X1 updated.
01700	
01800	Return
01900	------
02000	Non-skip on failure. Skip on success.
02100	
02200	Function
02300	--------
02400	If not  v1B,  use  DIRST  directly  (assume  version  2  or  higher).
02500	Otherwise, get directory from DIRST and STR=DSK.
02600	;
02700	
02800	DIRST.:	PROC
02900		IF	;New style dir no
03000			IFV1B
03100			GOTO FALSE
03200		THEN	;Use DIRST directly
03300			DIRST
03400			 RET	;Error ret
03500			AOS (XPDP)
03600			RET
03700		FI
03800		SAVE <X2,X3>
03900		N==2
04000		TLNE X2,-1
04100		 GOTO L9		;Incorrect format
04200		HRROI X2,[ASCIZ/DSK:</]
04300		SETZ X3,		; Finish with zero byte
04400		SOUT			; Output "DSK:<"
04500		 ERJMP L9
04600		L X2,1-N(XPDP)		; 18-bit dir no
04700		DIRST			; Directory name
04800		 GOTO L9
04900		LI ">"			; Close broket ">"
05000		BOUT
05100		AOS -N(XPDP)		; Ok return
05200	L9():!	RETURN
05300		N==0
05400		EPROC
     
00100		SUBTTL PPNST. PPN to string
00200	
00300	Comment;
00400	
00500	Purpose
00600	-------
00700	Simulate v2 action of PPNST JSYS.
00800	
00900	Input
01000	-----
01100	X1:	Byte pointer to output string.
01200	X2:	PPN (36 bit number)
01300	X3:	Pointer to name of structure where PPN is valid.
01400	
01500	Output
01600	------
01700	STR:<DIRECTORY> in output string. X1 updated.
01800	
01900	Return
02000	------
02100	Normal return always.
02200	
02300	Function
02400	--------
02500	If not running on v1B of TOPS-20, use PPNST directly.  Otherwise, get
02600	directory from programmer number via DIRST and STR=DSK.
02700	;
02800	
02900	PPNST.:	PROC
03000		IF	;Not v1B
03100			IFV1B
03200			GOTO FALSE
03300		THEN	;Use PPNST directly
03400			PPNST
03500			 ERJMP ERRRET
03600			RET
03700		FI
03800		SAVE <X2,X3>
03900		N==2
04000		TLC X2,4
04100		IF	;Ordinary user ppn
04200			TLNE X2,-1
04300			GOTO FALSE
04400		THEN	;Construct string starting with DSK:
04500			HRROI X2,[ASCIZ/DSK:</]
04600			SETZ X3,
04700			SOUT
04800			 ERJMP L3
04900			L X2,1-N(XPDP)
05000			DIRST
05100			 GOTO L3
05200			LI ">"
05300			BOUT
05400			 ERJMP L3
05500		ELSE	;Could be [1,4]
05600			IF	;[1,4]
05700				CAME X1,[1+4,,4]
05800				GOTO FALSE
05900			THEN	;Just output SYS: (not always correct)
06000				HRROI X2,[ASCIZ/SYS:/]
06100				SETZ X3,
06200				SOUT
06300				 ERJMP L3
06400				GOTO L9
06500			FI
06600	L3():!		RESTORE
06700			GOTO ERRRET	;Error
06800		FI
06900	L9():!	RETURN
07000		N==0
07100		EPROC
     
00100		SUBTTL STPPN. String to PPN
00200	
00300	Comment;
00400	
00500	Purpose
00600	-------
00700	Simulate v2 action of STPPN JSYS.
00800	
00900	Input
01000	-----
01100	X1:	Directory number (18 bits for v1B, 36 bits for  v2).  JFN  or
01200		string ptr not accepted - use RCDIR first.
01300	
01400	Output
01500	------
01600	X2:	PPN
01700	
01800	Return
01900	------
02000	Normal return always.
02100	
02200	Function
02300	--------
02400	If not running on TOPS-20 v1B, use  STPPN  directly.  Otherwise,  use
02500	directory number as programmer and 4 as project number.
02600	;
02700	
02800	STPPN.:	PROC
02900		IF	;New style number
03000			IFV1B
03100			GOTO FALSE
03200		THEN	;Use STPPN directly
03300			STPPN
03400			 ERJMP ERRRET
03500		ELSE	;Use 4 as proj no, dir no as progr no
03600			MOVSI X2,4
03700			HRRI X2,(X1)
03800		FI
03900		RET
04000		EPROC
     
00100		SUBTTL ERRRET, Interpret any ERJMP or ERCAL after call to some proc
00200	
00300	ERRRET:	PROC
00400		SAVE X1
00500		N==1
00600		L X1,-N(XPDP)	;Possible ERJMP or ERCAL
00700		TLC X1,(ERJMP)
00800		IF	;ERJMP
00900			TLNE X1,-1
01000			GOTO FALSE
01100		THEN	;Change return address
01200			HRRM X1,-N(XPDP)
01300		ELSE
01400		IF	;ERCAL
01500			TLNE X1,(777777B17-<Z 1,0>)
01600			GOTO FALSE
01700		THEN	;Restore ac's, go there with unchanged return
01800			RESTORE
01900			GOTO @(XPDP)
02000		FI FI
02100		RETURN
02200		EPROC
02300	
02400		LIT
02500		END