Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/call.tnx
There is 1 other file named call.tnx in the archive. Click here to see a list.
TENX <
DSCR
	TENEX VERSION OF THE DEC CALL FUNCTION

EXTERNALS USED HERE:  CVSIX,OUTSTR,.SKIP.,X22,ZSETST,ZADJST,
	CHRCAT,CAT,CATCHR,RUNPRG



HERE(CALL)
	
	DEFINE CALARG <-5(P)>		;WHERE THE ARGUMENT IS AT

	BEGIN CALL
	PUSH	P,2			;SAVE THESE ACS
	PUSH	P,3
	PUSH	P,4
	PUSH	P,5

	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	PUSHJ	P,CVSIX			;GET SIXBIT (BUT LEAVE STRING ON STACK)
	MOVSI	2,-CALTSZ
CALLUP:	CAMN	1,CAL6TB(2)
	  JRST	@CALDTB(2)		;FOUND THE ROUTINE
	AOBJN	2,CALLUP
;CANNOT FIND THE CALL IN THE TABLE
	PUSH	SP,-1(SP)		;PRINT OUT THE OFFENDING NAME
	PUSH	SP,-1(SP)
	PUSHJ	P,OUTSTR
	ERR <
CALL:  ABOVE CALL NOT EMULATED BY SAIL>,1
	SETZ	1,
	JRST	CALRET			;RETURN IF USER INSISTS

CALRES:	SETOM	.SKIP.			;HERE TO SKIP RETURN
	SKIPA
CALRET:	SETZM	.SKIP.
	POP	P,5
	POP	P,4
	POP	P,3
	POP	P,2
	SUB	SP,X22
	SUB	P,X22
	JRST	@2(P)


;ACTUAL EMULATING CODE LIVES HERE

..EXIT:	JSYS 	HALTF
	JRST	CALRET

..DATE:	SETO	2,			;CURRENT TIME AND DATE
	SETZ	4,			;GET YEAR, MONTH, DAY
	JSYS	ODCNV
	HLRZ	1,2			;YEAR
	SUBI	1,=1964
	IMULI	1,=12			;(YEAR-1964)*12
	ADDI	1,(2)			;(YEAR-1964)*12+(MONTH-1)
	IMULI	1,=31			;...*31
	HLRZ	3,3
	ADDI	1,(3)			;+ (DAY-1)
	JRST	CALRET			;AND RETURN	

..TIMER: SKIPA 5,[=60]
..MSTIME: MOVEI 5,=1000
	SETO	2,
	SETZ	4,
	JSYS	ODCNV
	MOVEI	1,(4)			;SECONDS SINCE MIDNIGHT
	IMUL	1,5
	JRST	CALRET			;NOW RETURN

..RUNTIM:
	SKIPE	CALARG			;JOB MENTIONED?
	   JRST	USESGT			;YES
	MOVNI	1,5			;ALL FORKS OF THE JOB
	JSYS	RUNTM
	JRST	CALRET

USESGT:	MOVE	1,[SIXBIT/TICKPS/]
	JSYS	SYSGT
	MOVE	B,A
	HRLZ	A,CALARG
	HRRI	A,1
	JSYS	GETAB
	  SETZ	A,			;ERROR
	JUMPGE	A,.+2			;POSITIVE NO. IS OK
	  SETZ	A,			;NEGATIVE NO. IS NO SUCH JOB
USESG1:	JRST	CALRET			;NOW RETURN




..PJOB:	JSYS	GJINF
	MOVE	1,3			;JOB NUMBER
	JRST	CALRET

..LOGOUT:	
	SETO	1,
	JSYS	LGOUT
	JRST	CALRET

..GETPPN:
	JSYS	GJINF
	PUSH	P,[=100]
	PUSHJ	P,ZSETST
	JSYS	DIRST			;DIR NO IN 2, STRING BP IN 1
	  ERR <CALL&GETPPN:  CANNOT DO DIRST>;ERROR RETURN
	PUSH	P,[=100]		;COUNT -- SEE ABOVE
	PUSH	P,1			;UPDATED BP
	PUSHJ	P,ZADJST		;GET STRING ON SP STACK
	PUSHJ	P,CVSIX			;GET SIXBIT, ADJUST STACK
	JRST	CALRET


SIX1:	PUSHJ	P,SAVE
	SKIPE	SGLIGN(USER)
	  PUSHJ P,INSET
	MOVEI	A,6	
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	  PUSHJ	P,STRNGC
	PUSH	SP,[0]			;COUNT WORD
	PUSH	SP,TOPBYTE(USER)
	MOVEI	A,6			;READ AT MOST 6 CHARS
	MOVE	B,[POINT 6,-1(P)]
	MOVEI	C,0			;COUNT CHARS ACTUALLY DONE
SIX2:	ILDB	TEMP,B
	JUMPE	TEMP,SIX3		;NULL?
	ADDI	TEMP,40			;MAKE INTO 7-BIT
	IDPB	TEMP,TOPBYTE(USER)
	AOJ	C,			;ANOTHER CHAR ADDED
SIX3:	SOJG	A,SIX2
	HRROM	C,-1(SP)		;COUNT WORD
	SUBI	C,6			;SET TO 
	ADDM	C,REMCHR(USER)		;ADJUST REMCHR
	MOVE	LPSA,X22	
	JRST	RESTR



..RUN:	MOVE	1,CALARG
	MOVE	2,(1)			;DEVICE SIXBIT
	CAMN	2,[SIXBIT/SYS/]		;DEVICE SYS?
	   JRST	USESYS			;YES
	CAME	2,[SIXBIT/DSK/]		;BETTER BE DSK
	   JRST	CALRET			;NO, RETURN TO USER
	SKIPN	4(1)			;ANY PPN MENTIONED?
	   JRST	[PUSH	P,1(1)		;USER NAME IN 6-BIT
		 PUSHJ	P,CVXSTR	;GET A STRING IN 7-BIT
		 JRST RUNNAM]
	PUSH	P,["<"]
	PUSH	P,4(1)			;PPN
	PUSHJ	P,SIX1			;GET 7-BIT STRING
	PUSHJ	P,CHRCAT		;<DIR
	PUSH	P,[">"]
	PUSHJ	P,CATCHR		;<DIR>
	JRST	GOTDIR

USESYS:	PUSH	SP,[=8]
	PUSH	SP,[POINT 7,[ASCIZ/<SUBSYS>/]]
GOTDIR: PUSH	P,1(1)			;NAME
	PUSHJ	P,SIX1 			;TO 7-BIT
	PUSHJ	P,CAT			;<DIR>NAME
RUNNAM:	PUSH	SP,[4]
	PUSH	SP,[POINT 7,[ASCIZ/.SAV/]]
	PUSHJ	P,CAT			;<DIR>NAME.SAV
	HLRZ	1,1			;THE INCREMENT
	PUSH	P,1
	PUSH	P,[0]			;DONT WANT A NEW FORK
	PUSHJ	P,RUNPRG
	JRST	CALRET			;ERROR RETURN




;CODE FOR IMSSS-SPECIFIC CALLIS

IMSSS<

..DATSAV:
	MOVE	1,CALARG
	JSYS	DATSV
	   JRST	CALRET
	JRST	CALRES

..PUTINF:
	SETO	1,
	MOVE	2,CALARG
	JSYS	PTINF
	   ERR <CALL:  PUTINF HAS FAILED>,1
	JRST	CALRET

..GETINF:
	SETO	1,
	MOVE	2,CALARG
	JSYS	GTINF
	   ERR <CALL:  GETINF HAS FAILED>,1
	JRST	CALRET

..RANDOM:	
	JSYS	RAND			;GET RANDOM NO. IN 1 AND 2
	JRST	CALRET


>;IMSSS


DEFINE CALTBL <

CZ EXIT
CZ DATE
CZ LOGOUT
CZ TIMER
CZ MSTIME
CZ GETPPN
CZ RUNTIM
CZ PJOB
CZ RUN
IMSSS<
CZ DATSAV
CZ PUTINF
CZ GETINF
CZ RANDOM
>
>

DEFINE CZ $ (X) <SIXBIT/$X$/>


CAL6TB:	CALTBL

CALTSZ__.-CAL6TB+1
	
DEFINE CZ $ (X) <..$X>
CALDTB:	CALTBL
	BEND CALL

ENDCOM(COD)
;END OF TENEX CODE FOR THE CALL FUNCTION

IFN ALWAYS,<BEND UTILS>

SUBTTL STRING HANDLING ROUTINES

>;TENX