Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	COMMON SUB ROUTINE LIBRARY
	SUBTTL	T KORTEWEG 17-FEB-74

VWHO==0
VINFL==0
VMINOR==0
VEDIT=113
;COPYRIGHT (C) 1978 DIGITAL EQUIPMENT CORPORATION MAYNARD MASS.

;EDIT HISTORY
;1 RUNNUM HAS BEEN UPDATED TO ALLOW AN INCREASE IN THE RUN NUMBER
;  WITHOUT A CHECK OF PASSWORD AND THE LAST TIME CALLED.THIS ENTRY
;  WAS MADE FOR DUMPR,WHICH ALLOWS DUMPS TO BE WRITTEN,TODIAGNOSE
;  PROBLEMS

;2 SCRASH HAS BEEN CHANGED SO AS NO LONGER TO DESTROY REGISTER 
;  V INTHE SAVED AREA MOREOVER ALLREGISTERS ARE RESTORED

;3 DUMPR HAS BEEN ADDED TO ALLOW THE WRITING FROM ANY LOCATION
;  OF A XPN FILE

	SEARCH	INFSYM
	;SAVER SAVES ALL ALL REGISTERS WITH THE EXCEPTION OF THE 
	;PUSHDOWN LIST ON THE STACK.(NOTE: IT IS ASSUMED THAT THE SYMBOL P
	;DEFINES THE PUSHDOWN LIST POINTER.).ONDOING THIS IT ASSUMES
	;THAT THE CALLERS RETURN ADDRESS SITS ON THE STACK TOP
	;ALL EXITS UP TO A 3 DOUBLE RETURN WILL BE PROPERLY
	;HANDLED
	;CALL WITH:
	;	CALL	SAVER
	;RETURN HERE
	;	RETURN		WILL ACTIVATE THE RESTORATION OF
	;			ALL REGISTERS

	ENTRY	SAVER

SAVER:	EXCH	0,(P)		;GET CALLERS PC+1
	SAVE	(ALL)		;SAVE ALL EXCEPT P AND REGISTER ZERO
	SAVEI	SAVRR		;SAVERS REURN
	SAVE	0		;SET RETURN TO CALLER
	RETURN			;AND GO
SAVRR:	JSP	T1,SVRRR	;(0) NON SKIP RETURN
	JSP	T1,SVRRR	;(1) SKIP RETURN
	JSP	T1,SVRRR	;(2) DOUBLE SKIP RETURN
	JSP	T1,SVRRR	;(3) DOUBLE + SKIP
SVRRR:	HRRZS	T1		;CLEAR FLAGS
	SUBI	T1,SAVRR+1	;GET THE SKIP VALUE
	HRRZ	T2,-20(P)	;GET THE CALLERS RETURN ADDRESS
	ADD	T2,T1		;AND ADD THE INCREMENT
	HRRM	T2,-20(P)	;AND SET THE UPDATED RETURN
	RESTORE	(ALL)		;RESTORE THE CONTEXT P AND 0 NOT!!
	RESTORE			;GET R0 BACK
	RETURN			;AND EXIT
	ENDMOD

	SEARCH	INFSYM

	ENTRY	GETCOR
;GETCOR GETS T1 WORDS OF CORE AND RETURNS THE ADDRESS IN V
;ANY FAILLURE TO GET CORE MAKES A NORMAL RETURN
;SUCCESFULL OPERATION IS FLAGGED BY A SKIP RETURN

	EXTERN	.JBFF,.JBREL,TPOPJ1,TPOPJ

GETCOR:	MOVE	V,.JBFF		;GET START OF FREE CORE
	SAVE	T1		;SAVE THE AMOUNT REQUESTED
	ADDB	T1,.JBFF	;ADD THE SIZE WISHED TO IT
	CAMG	T1,.JBREL	;IS THERE ENOUGH CORE
	JRST	TPOPJ1		;YES DO NOT ASK FOR MORE
	CORE	T1,		;GET IT
	JRST	TPOPJ		;GIVE A NON SKIP RETURN
	JRST	TPOPJ1	;RESTORE T1 AND SKIP RETURN
	ENDMOD

	SUBTTL	LIST OPERATIONS
;THE LIST IS CONTOLLED BY A 2 WORD BLOCK,WHICH HAS THE
;FOLLOWING FORMAT:
;1 WORD 0 POINTER TO FIRST ENTRY,,POINTER TO LAST ENTRY
;2 WORD 1 NUMBER OF ENTRIES IN Q
;EACH PRIMITIVE IS CALLED WITH THE ADDRESS OF THE LISTCONTROL 
;BLOCK IN L AND THE ADDRESS OF AN ENTRY IN V
;THE FOLLOWING PRIMITIVES ARE AVAILABLE:
;1 APPEND  ARGUMENT V TO LIST
;2 REMOVT REMOVE TOP ELEMENT FROM LIST RETURN ADDRESS INV
;3 REMOVE REMOVE ENTRY V FROM LIST
;4 SREMOV SEARCH .V IN LIST AND REMOVE IT
;  2 RETURNS (NORAML) V NOT IN LIST (SKIP) V REMOVED

	SEARCH	INFSYM

	ENTRY	APPEND,REMOVT,REMOVE,SREMOV
	EXTERN	CPOPJ,CPOPJ1

LI.LNK=0		;LINK TO NEXT ELEMENT
LI.NUM=1		;NUMBER OF ENTRIES IN LIST

;NOTE: THE FIRST WORD OF THE LIST LINKS TO THE REST OF THE LIST
; WITH A FORWARD AND BACKWARD POINTER
;ZERO=NIL TERMINATOR

APPEND:	SKIPE	LI.NUM(L)	;FIRST ELEMENT
	JRST	APPEN0		;NO REALLY APPENDING
	MOVE	T1,V		;POINT TO THE
	HRL	T1,V		;THE CURRENT
	MOVEM	T1,LI.LNK(L)	;SLOT
	MOVEI	T1,LI.LNK(L)	;AND GET LINK VALUE
	JRST	APPEN1
APPEN0:	HRRZ	T1,LI.LNK(L)	;GET PREVIOUS ELEMENT
	HRRM	V,LI.LNK(L)	;NOW WE ARE OLDEST MEMBER
	HRLM	V,LI.LNK(T1)	;UPDATE LIST MEMBER
APPEN1:	MOVEM	T1,LI.LNK(V)	;SET LINK IN LAST ELEMENT
	AOS	LI.NUM(L)	;ONE MORE IN LIST
	RETURN

;REMOVE TOP ELEMENT

REMOVT:	HLRZ	V,LI.LNK(L)	;GET TOP ELEMENT

;REMOVE GIVEN ELEMENT .V

REMOVE:	SOSGE	LI.NUM(L)	;ANY MORE IN LIST
	JRST	REMOV0		;RAP LINK
	HRRZ	T1,LI.LNK(V)	;PREVIOUS ONE
	HLRZ	T2,LI.LNK(V)	;RESET ONE
	HRLM	T2,LI.LNK(T1)	;UPDATE ANCHOR OR BUCKET
	SKIPN	T2		;IF LIST IS TERMINATED THEN ELSE
	MOVE	T2,L		;ELSE CHANGE THE LAST MEBER
	HRRM	T1,LI.LNK(T2)	;UPDATE BACKWARD POINTER
	RETURN
REMOV0:	SETZM	LI.NUM(L)	;THE LIST IS EMPTY
	SETZM	LI.LNK(L)	;RAP BACKWARD
	RETURN

;SEARCH .V IN LIST AND REMOVE IT IF PRESENT

SREMOV:	JUMPE	V,CPOPJ
	MOVE	T1,L		;COPY THE LIST ADDRESS
SREMO0:	HLRZ	T1,LI.LNK(T1)
	JUMPE	T1,CPOPJ
	CAME	T1,V
	JRST	SREMO0
	MOVE	V,T1
	CALL	REMOVE
	JRST	CPOPJ1
	ENDMOD

	SUBTTL	FREE LIST MANAGEMENT
	COMMENT	&
GETBLK	GETS A FREE BLOCK IN V AND GIVES A SKIP RETURN
	A NORMAL RETURN IS GIVEN WHEN NO MORE CORE IS AVAILABLE
	CORE IS ALLOCATED IN PAGES OR KAYS OF CORE.
NOTE:	1.  THAT GETBLK IS SELF INITIALIZING, THE INITIALIZATION
	    CODE ONLY SETS PAGE OR KAY DATA.
	2.  VARIABLE LOADED TRIES TO INFLUENCE THE BEHAVIOUR
	    OF SYS:INFO BY STOPPING THE ACCEPTANCE OF MESSAGES
RETBLK	RETURNS THE BLOCK IN V TO THE FREE LIST
INIBLK	DOES THE FIRST THINGS AS LITTLE AS POSSIBLE!!
	&

KAYSIZ=1777			;NUMBER OF WORDS PER KAY
PAGSIZ=0777			;NUMBER OF WORDS PERPAGE

		SEARCH	C,INFSYM

	ENTRY	BLKINI,GETBLK,GETTWO
	ENTRY	RETBLK,RETTWO

	EXTERN	GETCOR,CPOPJ1

	ND	FTDEBUG,0
	ND	FTFLOW,0

LI.SLN=1		;SUBLINK FOR TWIN BLOCKS
;V CONTAINS SIZE OF SLOTS IN LIST STRUCTURE

BLKINI:	MOVEM	V,LISIZ	;SAVE THE SIZE OF THE BUCKETS
	SETZM	FRELNK		;INITIALIZE CONTROL
	SETZM	FRENUM		;BLOCK
	MOVEI	T1,KAYSIZ	;AND INITIALIZE
	JUMPPT	T2,,BLKIN0	;EXPANSION DATA
	MOVEI	T1,PAGSIZ	;ACCORDING TO PROCESSOR
BLKIN0:	IDIVI	T1,(V)		;DIVIDE BY SIZE OF SLOTS
	MOVEM	T1,BCKPKP	;AS PAGES ARE BETTER
	IMULI	T1,(V)		;THEN KAYS TO EXPAND
	MOVEM	T1,BCKPKS
	RETURN

GETBLK:	SOSL	V,FRENUM	;ARE ANY BUCKETS AROUND
	JRST	GETBL2		;YES TAKE ONE
	IFN	FTFLOW,<
	SAVE	V
	MOVEI	V,CORMS1	;GET TEXT TO PRINT
	CALL	TYPOPB##	;TYPE THE TEXT
	JFCL			;AND IGNORE FAILLURE
	RESTORE	V
	JRST	NCOR1		;SKIP THE TEXT
CORMS1:	ASCIZ	/MORE CORE WAS REQUESTED]
/
NCOR1:
>
	MOVE	T1,BCKPKS	;CHUNK
	CALL	GETCOR		;GET T1 WORDS
	RETURN			;HAND THE PROBLEM TO THE CALLER
	MOVE	T2,V		;GET POINTER TO NEW CHUNK
	EXCH	T2,FRELNK	;SET ANCHOR ADDRESS TO IT
	MOVE	T3,BCKPKP	;# OF BUCKETS PER PAGE OR K
GETBL1:	MOVE	T4,V		;LET T4 POINT TO OLD SLOT
	ADD	V,LISIZ		;ADDRESS OF NEXT SLOT
	SOSG	T3		;IF LAST BUCKET IN NEW CHUNK THEN
	MOVE	V,T2		;TAKE OLD ANCHOR CONTENT
	MOVEM	V,(T4)		;POINT TO SUCCESSOR
	JUMPG	T3,GETBL1	;DO THIS FOR ALL BUCKETS
	MOVE	V,BCKPKP	;GET THE NUMBER OBTAINED
	ADDB	V,FRENUM	;AND SET THE NUMBER IN THE LIST
	IFN	FTDEBUG,<
	WARN	DO,<THERE ARE: >
	MOVE	T3,FRENUM
	CALL	PROC0
	WARN	DO,< (OCTAL) FREE ELEMENTS .THEY ARE:
>
	SAVE	<T1,T2,T3,T4>
	MOVE	T1,FRELNK		;FIRST FREE SLOT
TT..:	WARN	DO,<
>
	MOVEI	T2,5		;5 PER LINE
	SAVE	T2
TT0..:	MOVE	T2,T1	;PRINT IT
	CALL	PROCT
	MOVE	T1,(T1)
	JUMPE	T1,TT1..
	SOSE	(P)		;COUNT ON THE STACK
	JRST	TT2..
	RESTORE	T2
	JRST	TT..
TT2..:	WARN	DO,<    >
	JRST	TT0..
TT1..:	WARN	DO,<
>
	RESTORE	T1
	RESTORE	<T4,T3,T2,T1>
	WARN	DO,<
>>	;END OF IFN FTDEBUG
GETBL2:	MOVE	V,FRELNK	;GET THE FIRST FREE BUCKET
	MOVE	T1,(V)		;AND ITS SUCCESSOR
	MOVEM	T1,FRELNK	;GOES TO THE ANCHOR
	HRL	T1,V		;MAKE A
	HRRI	T1,1(V)		;BLT POINTER
	SETZM	(V)		;TO ZAP SLOT
	MOVE	T2,V		;START OF FREE SLOT
	ADD	T2,LISIZ	;ONE TOO FAR!!
	BLT	T1,-1(T2)	;SO NO HISTORY IS PASSED
	JRST	CPOPJ1

	SUBTTL	GET A PAIR OF FREE BLOCKS

GETTWO:	CALL	GETBLK		;GET ONE BLOCK
	RETURN			;NO ONE THERE
	SAVE	V		;DO NOT LOOSE IT
	CALL	GETBLK		;AND GET A SECOND ONE
	JRST	GETTW0		;JUST A FAILLURE
	HRLZ	T1,(P)		;GET THE FIRST BLOCK'S ADDRESS
	MOVEM	T1,LI.SLN(V)	;AND LINK THE BLOCKS
	RESTORE	W		;GET THE PAIRED REGISTER
	JRST	CPOPJ1		;ALL IS THERE
GETTW0:	RESTORE	V		;GET THE FIRST BLOCK BACK
	CALL	RETBLK		;RETURN THE BLOCK
	RETURN

	SUBTTL	RETURN FREE CORE

;CALLED WITH THE ADDRESS OF THE BLOCK
;TO BE RETURNED IN V

RETBLK:
	IFN	FTDEBUG,<
	CALL	TRACKV		;TRACE CALS AND V VALUE
	SKIPE	V		;RETURNING  AZERO LINK
	JRST	..RET0		;NO
	WARN	DO,<A ZERO BLOCK IS RETURNED>
	HALT
>
..RET0:
	IFN	FTDEBUG,<
	MOVEI	T1,L.FREE	;GET POINTER TO FRE LIST
..RET3:	CAME	T1,V		;MAKING THE LIST CIRCULAR
	JRST	..RET4		;NOT YET
	WARN	DO,<FREE LIST IS BEING MADE CIRCULAR>
	HALT
..RET4:	SKIPE	T1,(T1)
	JRST	..RET3		;THERE IS MORE ON THE LIST
>
	MOVE	T1,FRELNK	;GET CURRENT TOP OF LIST
	MOVEM	V,FRELNK	;REPLACE TOP ADDRESS
	MOVEM	T1,(V)	;MAKE RETURNED BLOCK THE TOP ONE
	AOS	T1,FRENUM	;ONE MORE FREE
	IFN	FTDEBUG,<
;INSPECT THE FREE LIST
	SAVE <T1,T2,T3>
	MOVE	T1,FRENUM	;THE NUMBER OF FREE ELEMENTS
	MOVEI	T2,L.FREE	;THE FREE LIST
	SETZM	T3		;ZAP T3
..RET1:	SKIPE	T2,(T2)		;LAST ONE
	AOJA	T3,..RET1	;NO COUNT IT
	CAMN	T3,T1		;IDENTICAL?
	JRST	..RET2		;YES FORGET IT
	WARN	DO,<DISCREPANCY BETWEEN ACTAUL FREE AND ACCOUNTED AS FREE>
	HALT
..RET2:	RESTORE	<T3,T2,T1>
>
	RETURN

;RETTWO IS THE INVERSE FUNCTION OF GETTWO
;THE ADDRESS OF THE TWIN BLOCK IS IN V

RETTWO:	SAVE	V		;SAVE THE BASE ADDRESS
	HLRZ	V,LI.SLN(V)	;GET THE BROTHER
	IFN	FTDEBUG,<
	SKIPN	V		;IS IT OKAY OR
	CALL	WRNBLN		;IT IS MESSED UP
>
	CALL	RETBLK		;AND DELETE HIM
	RESTORE	V		;GET THE OTHER BROTHER
	PJRST	RETBLK		;AND RETURN HIM TOO

FRELNK:	EXP	0		;FIRST FREE ELEMENT
FRENUM:	EXP	0		;NUMBER OF FREE ELEMENTS
LISIZ:	EXP	0		;NUMBER OF FREE ELEMENTS
BCKPKP:	EXP	0		;NUMBER OF BUCKETS PER PAGE
BCKPKS:	EXP	0		;SIZE OF AN EXTENSION OF THE LIST
	ENDMOD

	SUBTTL PRINTERS

	SEARCH	INFSYM
	ENTRY	PRDEC,PRDECH,PROCT,PROCTH



;PRDEC PRINTS THE CONTENT OF V IN DECIMAL SUPPRESSING LEADIND NULS
;PRDECH PRINTS THE RIGHT HAND SIDE OF V IN DECIMAL
;PROCT PRINT THE CONTENT OF V IN OCTAL (L,,R FORMAT)
;PROCTH PRINTS THE RIGHT HAND SIDE OF V IN OCTAL

PRDEC:	SKIPA	T1,V		;COMPLETE V WILL BE PRINTED
PRDECH:	HRRZ	T1,V		;ONLY THE RIGHT HAND SIDE
	MOVEI	T3,^D10		;RADIX IS DECIMAL
	JRST	PRANY		;PRINT ANY RADIX
PROCT:	HLRZ	T1,V		;GET THE LEFT HAND SIDE
	CALL	PROC0		;PRINT IT
	MOVEI	T1,.CHCOM	;A COMMA SEPERATES
	WARNCH	DO,T1		;PRINT ONE
	WARNCH	DO,T1		;AND ANOTHER ONE
PROCTH:	HRRZ	T1,V		;PRINT ONLY THE RIGHT HAND SIDE
PROC0:	MOVEI	T3,^D8		;PRINT IN OCTAL
;AND FALL INTO PRANY
PRANY:	IDIVI	T1,(T3)		;GET A DIGIT
	SAVE	T2		;SAVE THE DIGIT
	SKIPE	T1		;ALL DONE??
	CALL	PRANY		;NO PRINT MORE
	RESTORE	T2		;GET THE DIGIT BACK
	ADDI	T2,.CHZRO	;MAKE IT ASCII
	WARNCH	DO,T2		;TYPE THE CHARACTER
	RETURN
	ENDMOD

	SEARCH	INFSYM
	ENTRY	PR6BIT

;A SIXBIT PRINTER 
;PRINT THE VALUE IN V INSIXBIT

SIXBAS=40

PR6BIT:	MOVE	T1,V		;COPY THE VALUE
PR6BI0:	SETZ	T2,		;ZERO BIT GENERATOR:
	ROTC	T1,6		;GET FIRST BYTE
	ADDI	T2,SIXBAS	;MAKE IT PRINT TABLE
	TTCALL	1,T2		;PRINT IT
	JUMPN	T1,PR6BI0	;PRINT NEXT BYTE
	RETURN
	ENDMOD

	TITLE	CRASH
	SEARCH	C,INFSYM
	EXTERN	CPOPJ1,CPOPJ
	ENTRY	CRASH,STCRSH,DUMPR

;STCRSH PREPARE DATA FOR ENTERING A CRASH FILE
;CALLED WITH ADDRESS OF CRASH FILE NAME IN V
;THIS CALL ENABLES CRASH CALLS

STCRSH:	JUMPE	V,CPOPJ		;DON'T FOOL ME
	MOVEM	V,CRSHNM	;REMEMBER THE NAME
	JRST	CPOPJ1		;AND EXIT

;CRASH CAN BE CALLED FROM ANY PLACE AND WILL DUMP
;THE CURRENT CORE IMAGE UP TO .(.JBFF) (SEE HOW BAD ARE DOTS BLIS-10)
;HAIL ALGOL-68 WITH REF
;THE DUMP WILL RELEASE CHANNEL 0.THE NAME GIVEN TO THE DUMP FILE
;WILL BE DETERMINED BY THE ENTER BLOCK WHOSE ADDRESS IS PASSED BY
;THE CALLER IN REGISTER V.
;THE FILE WILL BE WRITTEN ON GENERIC DSK IN MODE 17
;WHAT EVER THE DEVICE IS . THE DEVSIZ UUO WILL BE USED TO FIGURE 
;OUT THE DEVICE BUFFER SIZE.THE REGISTERS ON ENTRY ARE
;STORED IN AREA STARTING AT CRSH0
;NOTE THAT ONLY T REGISTERS ARE BLOWN

CRASH::	SKIPN	CRSHNM	;IS THERE A NAME??
	RETURN			;(NO) DO NOT DUMP
	MOVEM	.CRSH0		;CRASH ACC 0
	MOVEI	.CRSH1		;HERE IT GOES
	HRLI	1		;STARTING WITH REGISTER 1
	BLT	.CRS17		;ALL ACCS
	MOVE	V,CRSHNM	;NAME OF CRASH BLOCK
	HRLZ	T1,.JBFF##	;SAVE THE LOW PART OF CORE
	HRRZ	T2,.JBFF	;SEE IF WE HAVE ENOUGH CORE
	SETZ	T4,		;MODE 0 FOR DEVSIZ
	MOVSI	T5,(SIXBIT /DSK/)	;DISK IS OUR DEVICE
	MOVEI	T3,T4		;GET ADDRESS OF ARGUMENT LIST
	DEVSIZ	T3,		;TRY TO GET DEVSIZ
	RETURN			;TO BAD YOU LOOSE
	MOVEI	T3,-3(T3)	;SUBTRACT HEADER
	MOVN	T4,T3		;GET LENGTH MINUS
	MOVE	T5,T3		;AND COPY BLOCK LENGTH
	ADD	T2,T3		;THIS MUCH WE NEED
	CAMG	T2,.JBREL##	;IS THERE ENOUGH CORE??
	JRST	COROK		;NO PROBLEM
	CORE	T2,		;ASK FOR MORE
	HALT			;WHAT TO DO ELSE?? LATER
COROK:	HRRZ	T2,.JBFF		;START OF FREE AREA
	SETZM	(T2)		;ZAP THE START
	HRRI	T1,1(T2)	;TARGET ADDRESS
	ADDI	T3,-1(T2)	;POINT TO END OF AREA
	BLT	T1,(T3)		;ZAP
	HRLI	T1,.JBPFI##+1	;START OF UNPROTECTED AREA
	HRRI	T1,.JBPFI+1(T2)	;START IN TARGET AREA
	BLT	T1,(T3)		;COPY NON PROTECTED DATA
	RELEASE	0		;NO MATTER WHAT IS GOING ON THERE
	OPEN	0,(V)		;OPEN USER'S DEVICE
	RETURN			;SORRY YOU LOOSE
	ENTER	0,3(V)		;USE CALLERS BLOCK
	RETURN			;LOOSER AGAIN
	HRL	T1,T4		;GET MINUS BLOCK LENGTH
	SETZM	T2		;ZAP END OF IOWD LIST
	HRR	T1,.JBFF	;START OF IOWD AREA
	SUBI	T1,1		;ONE WORD BEFORE START
	OUTPUT	T1		;WRITE PART WITH DATA <JOBPFI
	HRRZ	T1,.JBFF	;GET FIRST FREE LOCATION
	ADD	T1,T4		;SUBTRACT BLOCK SIZE
	JUMPL	T1,CRSML	;A VERY SMALL CRASH ONLY
	MOVNS	T1		;MINUS NUMBER OF WORDS STILL TO GO
	HRLS	T1		;MAKE A NEW IOWD
	HRRI	T1,-1(T5)	;START AFTER FIRST BLOCK
	OUTPUT	T1		;AND WRITE LAST PART OF CORE IMAGE
CRSML:	RELEASE	0,		;WRITE EOF
RESTAC:	MOVSI	17,.CRSH0	;GET SOURCE TARGET POINTER
	BLT	17,16		;LAST ONNE RESTORED IS 16
	MOVE	17,.CRS17	;AND GET REGISTER 17 BACK
	JRST	CPOPJ1		;HAPPY CALLER

;DUMPR USED TO DUMP THE CURRRENT CORE IMAGE

DUMPR:	SETOM	DMPFLG		;FLAG WE ARE DOING THE DUMP
	CALL	CRASH		;JUST USE CRASH TO SAVE STUFF
	RETURN			;FAILLURE EXIT
	SETZB	V,DMPFLG	;ZAP V
	CALL	RUNNUM##	;UPDATE THE RUN NUMBER
	JRST	RESTAC		;IGNORE THE PROBLEM
	MOVE	V,CRSHNM	;GET ADDRES OF NAME BLOCK
	HRRM	T1,3(V)		;AND UPDATE THE NAME
	CALL	SIXNUM##	;CONVERT TO SIXBIT
	JRST	RESTAC		;RESTORE ACCS AND RETURN

DMPFLG:	Z			;-1 WHEN  DUMPER DUMP
;AREA TO SAVE ACC'S ON A CRASH

CRSHNM:	Z			;ADDRESS OF CRASH FILE NAME
.CRSH0:	Z			;SAVE ACC 0 HERE
.CRSH1:	Z			;SAVE ACC 1 HERE
	BLOCK	15		;SAVE ACC2 TILL ACC 16 HERE
.CRS17:	Z		;SAVE ACC 17 HERE

	ENDMOD

	TITLE	TYPOPR
	SEARCH	C,INFSYM
	ENTRY	TYPOPR,SETOPR,SETUDX,TYPOP0,TYPOPB
;SETOPR ALLOWS OUTPUT TO ANY TERMINAL VIA TRMOP OPRATIONS
;FIRST CALL SETOPR WITH THE FOLLOWING PARAMETERS:
;.T1 TTY YOU WANT E.G. TTY10(IN SIXBIT)
;.V  ZERO OR ADDRESS OF ASCIZ TEXT TO START EVERY OUTPUT
;IN CASE YOU KNOW THE UDX OF THE TERMINAL CALL SETUDX
;WITH UDX IN T1
;RETURNS FALSE AND TRUE

SETOPR::CALLI	T1,127		;WAIT FOR BETTER C FILE
;	IONDX.	T1,		;TRY TO GET IT
	RETURN			;YOU LOOSE
SETUDX::MOVEM	T1,.TXTX	;STORE THE INDEX
	MOVEM	V,.TXTH		;REMEMBER PREFIX
	JRST	CPOPJ1##	;LUCKY YOU

;TYPOPR TYPES ON THE CTY PROVIDED THE FACT THAT YOU
;HAVE THE PRIVILIGE TO DO SO.
;TYPOPB TOO TYPOPR PRECEDES TEXT BY ?? AND OPB BY]]
;CALL TYPOPR WITH THE ADDRESS OF THE STRING TO BE TYPED
;IN REGISTER V. THIS FUNCTION IS AN EMERGENCY FOR SYSTEM
;PROGRAMS,WHICH ARE IN PAIN AND ARE SO UNLUCKY TO BE
;TO BE DETACHED. TO WAKE SLEEPY OR TOO BUSY OPERATORS
;YOY MIGHT ADD SOME BELLS.
;IF YOU LOOSE A NORMAL RETURN ELSE THE HAPPY TRUE EXIT

TYPOPB::	SKIPN	.TXTX		;HAS I/O INDEX BEEN SET UP
	RETURN		;NO FORGET IT
	MOVEI	T1,LFTSQB		;LEFT SQUARE BRACKETS
	JRST	TYPOP1			;TYPE THEM

TYPOPR::	SKIPN	.TXTX		;HAS I/O INDEX BEEN SET UP
	RETURN			;YOU LOOSE
	MOVEI	T1,QUESTM	;GET ?? TEXT
TYPOP1:	MOVEM T1,.TXTA		;SET UP FOR PRINTING
	MOVE	T1,.TXT0	;GET TRMOP CTL BLOCK
	TRMOP.	T1,		;PRINT IT
	RETURN			;YOU ARE BAD
	SKIPN	T1,.TXTH	;ANY PREFIX FOR SENTENCE?
	JRST	NOPREF		;NONE SO DON'T PRINT
	MOVEM	T1,.TXTA	;YES LET IT GO FIRST
	MOVE	T1,.TXT0	;GET TRMOP CTL BLOCK
	TRMOP.	T1,		;TRY TO GET MESSAGE ACROSS
	RETURN			;NO YOU ARE A BAD GUY
TYPOP0::
NOPREF:	MOVEM	V,.TXTA		;TEXT ADDRESS
	MOVE	T1,.TXT0	;GET TRMOP CTL BLOCK
	TRMOP.	T1,		;TRY TO GET IT ACROSS
	RETURN			;HE DID NOT GET IT
	JRST	CPOPJ1##	;HAPPY ME

.TXT0:	3,,.TXT		;NO LITERAL PROBLEMS
.TXT:	EXP	.TOOUS		;WRITE
.TXTX:	Z			;I/O INDEX COMES HERE
.TXTA:	Z			;ADDRESS OF ASCIZ STRING COMES HERE
.TXTH:	Z		;ADDRSS OF MESSAGE PREFIXES
LFTSQB:	ASCIZ	/[/		;INNOCENT TEXTS
QUESTM:	ASCIZ	/??/		;PROBLEM REPORTERS
	ENDMOD

	TITLE	SETSTA
	SEARCH	C,INFSYM
	ENTRY	SETSTA,RESTAR

;SETSTA AND RESTAR ARE CONJUGATE ROUTINES
;THIS MEANS SETSTA PREPARES THE RESTART OF A PROGRAM
;AND RESTAR RERUNS THE PROGRAM.
;TO ENABLE RESTARTING CALL SETSTA IMMEDIATELY
;AFTER SETTING UP A STACK AND NOT USING A RUN ACCU
;AS A STACK POINTER PLEASE.THIS WILL ENABLE RESTAR
;CALING RESTAR CAN RESULT IN:
;1 A RETURN IF THE RESTAR LOOSES 
;2 NO RETURN WHEN THE PROGRAM WAS RESTARTED
;NOTE: THAT THE JOB WILL ATTACH TO THE CTY WHENEVER THE CONTROLLING
;LINE NUMBER HAS CHANGED , THIS IS TO GET DAEMON BACK ON THE AIR

SETSTA::0			;NO STACK PROBLEMS PLEASE
	SETOM	.RESTF		;SET THE BOOLEAN TO ENABLE RESTART
	MOVEM	.SGNAM,RUNNAM	;REMEMBER THE NAME
	MOVEM	.SGPPN,RUNPPN	;AND PPN 
	MOVEM	.SGDEV,RUNDEV	;AND DEVICE 
	MOVEM	.SGLOW,RUNEXT	;AND EXTENSION
	JRST	@SETSTA		;RETURN

RESTAR::SKIPL	.RESTF		;ARE WE ENABLED
	RETURN			;NO FORGET IT
	MOVEI	T1,RUNDEV	;RUN DEVICE
	HRLI	T1,2		;IDENTIFY THE RESTART
	RUN	T1,		;MAYBE YOU GO
	MOVE	T1,[SIXBIT /DAEMON/]	;CHANGE NAME IF TRUE
	CAME	T1,RUNNAM		;ELSE EXITS DO NOT WORK
	RETURN
	HLLZS	T1			;GET DAE NAME
	SETNAM	T1,			;SET THE NAME
	RETURN

.RESTF:	Z			;IMPURE RESTART FLAG
RUNDEV:	Z			;NAME OF RUN DEVICE
RUNNAM:	Z			;NAME OF RUN DEVICE
RUNEXT:	Z			;NAME OF EXTENSION
	Z
RUNPPN:	Z			;OWNERS PPN
	Z			;NO CORE ARGUMENT
	ENDMOD

	SEARCH	C,INFSYM
	DOINT	(ILU)		;SET ILLEGAL USER TRAP

	SEARCH	C,INFSYM
	DOINT	(ILM)		;SET ILLEGAL MEMORY TRAP

	SEARCH	C,INFSYM
	DOINT	(ADC)		;SET ADDRESS CHECK TRAP

	SEARCH	C,INFSYM
	DOINT	(PDL)		;PUSH DOWN LIST TRAP

	SEARCH	C,INFSYM
	DOINT	(NXM)		;NONEXISTING MEMORY TRAP

	SEARCH	C,INFSYM
	DOINT	(EJE)		;EXTERNAL JOB ERROR

	TITLE	RUNNUM
	ENTRY	RUNNUM,ZAPRUN
	SEARCH	C,INFSYM
	EXTERN	TPOPJ,CPOPJ1,SIXNUM,CPOPJ

;RUNNUM IS CALLED TO FIGURE IT HOW MANY TIMES
;A PROGRAM HAS BEEN RUN AND TO INCREASE THE RUN NUMBER
;THERE ARE 2 CALLS:
;1 A CALL TO JUST UPDATE THE RUN NUMBER (.V EQL 0)
;2 A CALL TO UPDATE THE NUMBER AND CHECK THE LEGALALITY
;  OF THE USER AND VERIFY WHTHER THE RERUN WAS 'TOO SOON'
;THIS IS DONE BY WRITING A TEMP FILE WITH THE NAME
;XXX'XXX.TMP XXX=JOB NUMBER IN 6 BIT
;AND CHECKING A PROGRAM PASSWORD
;TO PREVENT AN INFINITE LOOP THE CURRENT TIME HAS TO EXCEED
;A USER SPECIFIED MARGIN IN MILLISECONDSZERO VALUES WILL BE
;REJECTED.
;TO USE THIS FACILITY (2) THE USER MUST CALL RUNNUM WITH
;THE ADDRESS OF A PARAMETER BLOCK IN V,
;THE LAY OUT OF THIS PARAMETER BLOCK IS:
;WORD 0	THIS WILL BE USED TO CHECK THE TMP FILE(PASSWORD)
;WORD 1 THIS WILL BE SET TO THE START NUMBER OF THE RUN
;WORD 2 CONTAINS THE MINIMUM TIME DELTA BETWEEN SUCCESSIVE RUNS

RUNNUM:	SAVE	V		;PARAMETER BLOCK
	PJOB	V,		;GET JOB NUMBER
	CALL	SIXNUM		;CONVERT IT
	JRST	TPOPJ		;GO BACK WRONG!
	RESTORE	V		;GET PARAMETER BLOCK ADDRESS BACK
	HRLZM	T1,NAME		;STORE NAME PART
	MOVEI	T1,NAME		;POINT TO ARG BLOCK
	HRLI	T1,.TCRRF	;READ FUNCTION
	TMPCOR	T1,		;GET RESULT INT2,T3,TT4,T5
	JRST	NEW		;FIRST RUN
	SKIPN	V		;VERIFICATION REQUIRED?
	AOJA	T3,WRFILE	;NO WRITE THE FILE AGAIN
	CAME	T2,(V)		;IS PASSWORD OKAY?
	JRST	NEW		;(NO) MUST BE NEW
;THIS IS CLEARLY A RESTART
	ADDI	T3,1		;INCREASE SEQ NUMBER
	DATE	T1,		;GET THE DATE
	CAMN	T1,T4		;THE SAME DAY??
	JRST	SAMED		;(YES) CHECK TIME
	MOVE	T4,T1		;RESET DAY
	MSTIME	T5,		;GET TIME
	JRST	WRFILE		;WRITE THE NEW FILE
SAMED:	MOVE	T1,2(V)		;GET THE ALLOWABLE DIFFERENCE
	JUMPE	T1,CPOPJ	;THERE MUST BE A DIFFRENCE
	ADD	T1,T5		;GET OLD TIME
	MSTIME	T5,		;GET THE CURRENT TIME
	CAMGE	T5,T1		;IS INTERVAL PERMISSIBLE??
	RETURN			;CRASH DIFFERENCE IS TOO SMALL
	JRST	WRFILE		;WRITE IT AGAIN
NEW:	MOVE	T2,(V)		;GET PASSWORD
	SETZ	T3,		;ZAP SEQ #
	DATE	T4,		;GET THE DATE
	MSTIME	T5,		;AND TIME
WRFILE:	MOVSI	T1,.TCRWF	;WRITE THE FILE
	HRRI	T1,NAME
	TMPCOR	T1,		;DELETE PREVIOOUS VERSION
	RETURN			;TOO BAD 
	SKIPN	V		;VERIFICATION CALL?
	SKIPA	V,T3		;NO RETURN RUN VALUE
	MOVEM	T3,1(V)		;STORE THE SEQUENCE NUMBER
	JRST	CPOPJ1		;THAT'S ALL

;ZAPRUN ZAPS THE TMPCOR FILE
;THEREBY MAKING REFINDING OF OLD RUN DATA IMPOSSIBLE

ZAPRUN:	PJOB	V,		;GET JOB NUMBER
	CALL	SIXNUM		;GET THE JOB NUMBER IN 6 BIT
	RETURN			;YOU HAD A BAD NUMBER BOY
	HRLZM	T1,NAME		;SET NAME FIELD
	HRRI	T1,NAME		;POINT TO ARG BLOCK
	HRLI	T1,.TCRDF	;READ AAND DELETE FILE
	TMPCOR	T1,		;ZAP IT
	RETURN
	JRST	CPOPJ1		;ALL SET SIR

NAME:	Z			;NAME,,0 FOR TMPCOR UUO
	IOWD	4,T2		;READ INTO ACCUS
	ENDMOD

	TITLE	SIXNUM
	ENTRY	SIXNUM
	SEARCH	INFSYM

;CONVERT THE BINARY IN ACCU V IN A STRING OF ALPHANUMERICS
;THE NUMBER IS HAS LESS THAN 6 DIGITS!!
;THE STRING IS RETURNED IN T1
;THE ERROR RETURN IS GIVEN IF THE NUMBER HAS MORE THAN 6 DIGITS
;THE STRING IS RIGHT ADJUSTED WITH LEADING SIBIT ZERO

SIXNUM:	TLNE	V,-1		;AN ILLEGAL NUMBER??
	RETURN			;(YES) GIVE THE FALSE RETURN
	MOVE	T2,[POINT 6,T1]	;GET POINTER TO T1
	MOVE	T3,[POINT 3,V,17]	;GET POINTER TO BINARY
SIXNU0:	ILDB	T4,T3		;GET A DIGIT
	ADDI	T4,20		;MAKE IT 6 BIT
	IDPB	T4,T2		;STORE THE CHARACTER
	TLNE	T2,770000	;FILLED THE WORD??
	JRST	SIXNU0		;NO FILL MORE
	JRST	CPOPJ1##	;SKIP RETURN
	ENDMOD

	SEARCH	INFSYM

	ENTRY	CPOPJ2,CPOPJ
	ENTRY	TPOPJ2,TPOPJ1,TPOPJ
	ENTRY	VPOPJ

TPOPJ2:	POP	P,T1
CPOPJ2:	AOSA	(P)
TPOPJ1:	POP	P,T1
	AOSA	(P)
TPOPJ:	POP	P,T1
CPOPJ:	POPJ	P,

VPOPJ:	POP	P,V		;RESORE V
	RETURN			;AND RETURN
	ENDMOD

	TITLE	CPOPJ1
	ENTRY	CPOPJ1
	SEARCH	INFSYM

;PREVENT GLOBAL CONFLICT WITH SCANER

CPOPJ1:	AOS	(P)	;RETURN +1
	RETURN
	ENDMOD

	TITLE	ERROR
	ENTRY	ECOD7,ECOD6,ECOD5,ECOD4,ECOD3,ECOD2,ECOD1,ECOD0
	SEARCH	INFSYM

;GIVE ERROR VALUES BACK IN REGISTER T1,THIS PRESERVES V!

ECOD7:	JSP	T1,ECO0		;ZERO BASE
ECOD6:	JSP	T1,ECO0
ECOD5:	JSP	T1,ECO0
ECOD4:	JSP	T1,ECO0
ECOD3:	JSP	T1,ECO0
ECOD2:	JSP	T1,ECO0
ECOD1:	JSP	T1,ECO0
ECOD0:	JSP	T1,ECO0
ECO0:	HRRZS	T1		;ZAP PROCESSOR FLAGS
	SUBI	T1,ECO0		;REDUCE THE PC
	RETURN
	ENDMOD
	END