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

MODULE MISC=
!
!Miscellaneous TOPS-10 dependant routines
!

!
! Facility:	NETSPL	on TOPS-10 only
!
BEGIN
!
! Conditional compilation
!
COMPILETIME FTNETSPL=(%VARIANT AND 2) NEQ 0;
COMPILETIME FTRMCOPY=NOT FTNETSPL;

!
! Table of contents
!
%IF NOT FTRMCOPY %THEN
FORWARD ROUTINE
SCALLI, !Execute a CALLI return 1 if skip 0 otherwise (ignore value returned)
RCALLI,	!Do a CALLI & return value in register
HIBERN,	!Sleep until something interesting happens
 !The following routines convert fields between DAP & system format
 !The suffix _DS means convert from DAP to system format, _SD the reverse
NETQDEV,!Return device FTS requests are queued to
GETLNN, !Get local node number
WHERE,  !Get node number where device is located
DTM_DS,	!Date & Time
DTM_SD,
PRO_QS,	!Convert from RMCOPY format (almost the same as DAP) to sys format
PRO_QD,	!Convert from the 9-bit-byte format in the queue to DAP EX format
PRO_DS;
%FI

FORWARD ROUTINE
PRO_SD;	!Protection

%IF NOT FTRMCOPY %THEN
FORWARD ROUTINE
DAT_DS,	!DATATYPE
DAT_SD,
DTE_SD,	!Date only
TIM_SD,	!Time only
WRDTM,	!Convert date & time to ASCII
TSTAMP,	!Write a time stamp
WRNM2A,	!Write a 2 digit non-zero-supressed decimal number to string
WRNUMF,	!Write a number to a fixed field
FIXIMG;	!Don't extend file by 1 word in Image mode
%FI

!
! Libraries
!

%IF NOT FTRMCOPY %THEN
REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';
%ELSE
LIBRARY 'TBL';
%FI
!
! Version information
!
THIS_IS [MISC]	VERSION [1]	EDIT [6]	DATE [10,DEC,79]
!
!	R E V I S I O N   H I S T O R Y
!
%(
[6]	Fix FIXIMG routine to really work
[5]	Put in FIXIMG routine to not extend image-mode files by 1 word
[4]	Put in WRNUMF routine to write fixed-length fields
[3]	Break out part of TSTAMP into WRDTM
[2]	Make NETSPL wake up every now and then on general principle
[1]	The beginning

END	R E V I S I O N   H I S T O R Y		)%

UNDECLARE %QUOTE DATE;
!
! External routines
!
%IF FTNETSPL %THEN
EXTERNAL ROUTINE
DATE,
MSTIME,
WRNUM,
MOVEAZ,
RDNUM;			!Read number from ASCII string
!
! Literals
!

LITERAL SLEEPTIME=1;
LITERAL WHEREUUO=%O'63';	!WHERE UUO on TOPS-10=CALLI 63

GLOBAL BIND MONTAB=
	UPLIT('JAN','FEB','MAR','APR','MAY','JUN',
		'JUL','AUG','SEP','OCT','NOV','DEC'):VECTOR;
!GLOBAL BIND MONTHLEN=
!	UPLIT(31,28,31,30,31,30,31,31,30,31,30,31);

!
! Builtin
!
BUILTIN MACHSKIP,MACHOP;

!
! Routines
!
GLOBAL ROUTINE SCALLI(FUN,ARG)=
	BEGIN
	REGISTER FF,A;
	A=.ARG;
	FF=.FUN;
	IF MACHSKIP(%O'047',A,0,FF) THEN 1 ELSE 0
	END; !SCALLI

GLOBAL ROUTINE RCALLI(FUN,ARG)=
	BEGIN
	REGISTER FF,A;
	A=.ARG;
	FF=.FUN;
	IF MACHSKIP(%O'047',A,0,FF) THEN .A ELSE 0
	END; !RCALLI

GLOBAL ROUTINE GETTAB(ARG)=RCALLI(%O'41',.ARG);

GLOBAL ROUTINE HIBERN=
!Routine to go to sleep until something happens
BEGIN
REGISTER R;
GLOBAL HIBTIME: INITIAL(XWD(%O'320',SLEEPTIME*1000));
R=.HIBTIME;
CALLI(R,%O'72');
WIN
END;

GLOBAL ROUTINE NETQDEV=
!Return sixbit name of device FTS requests are queued to
!Returns: SIXBIT network queue device
BEGIN
REGISTER	R,
		S;

S=GETLNN();	!Get our node number
R=%SIXBIT'NETS00';	!Template
R<6,3>=.S<3,3>;	!Move first digit
R<0,3>=.S<0,3>;	!Move second digit
.R		!Return sixbit device name
END;		!NETQDEV

GLOBAL ROUTINE GETLNN=
!Return host node number
!Returns: host node number

WHERE(%SIXBIT'CTY');	!The CTY is always connected to the host

GLOBAL ROUTINE WHERE(DEV)=
!Find the node a device is connected to
!DEV: SIXBIT device name
!Returns: node number
BEGIN
REGISTER R;

R=.DEV;
CALLI(R,WHEREUUO);	!Do the UUO
.R			!Node number is in the register
END;	!WHERE

GLOBAL ROUTINE DTM_DS(STR,SDATE,STIME)=
!Convert ASCII date & time to internal format 
!Arguments:
!STR:	String containing date&time 'dd-mmm-yy hh:mm:ss'
!--Next 2 args are address to return:
!SDATE:	Date in internal format
!STIME:	Time in internal format
BEGIN
LOCAL PTR;
LOCAL MMM,DD,YY,HH,MM,SS;

PTR=CH$PTR(.STR);
DD=RDNUM(PTR,10);		!Get day of month
CH$RCHAR_A(PTR);		!Skip over '-'
MMM=0;				!Clear it first
CH$MOVE(3,.PTR,CH$PTR(MMM));	!Get month in ASCII
PTR=CH$PLUS(.PTR,4);		!Skip over 3 chars of month and '-'
YY=RDNUM(PTR,10);		!Get year
CH$RCHAR_A(PTR);		!Skip over space
HH=RDNUM(PTR,10);		!Get hour of day
CH$RCHAR_A(PTR);		!Skip over ":"
MM=RDNUM(PTR,10);		!Get minute
CH$RCHAR_A(PTR);		!Skip over ":"
SS=RDNUM(PTR,10);		!Get second

!Now convert month to number

MMM=(INCR M FROM 0 TO 11 DO IF .MONTAB[.M] EQL .MMM THEN EXITLOOP .M);
.SDATE=((((.YY-64)*12)+.MMM)*31)+.DD-1;	!Date in TOPS-10 format
.STIME=((.HH*60)+.MM);		!Minutes since midnight
END;

GLOBAL ROUTINE DTM_SD(STR,SDATE,STIME)=
!Convert internal date & time to DAP format
!Arguments:
!STR:	Address to write string (area must be big enough for 18 characters)
!SDATE: TOPS-10 File System format date (MINUTES past midnight)
!STIME:	System format time
BEGIN
LOCAL PTR;

PTR=CH$PTR(.STR);
DTE_SD(PTR,.SDATE);	!Do the date
CH$WCHAR_A(%C' ',PTR);	!space
TIM_SD(PTR,(.STIME*60*1000));	!and the time (converting to milliseconds)

END;

GLOBAL ROUTINE PRO_QS(PRO)=
!Convert protection field from RMCOPY (via QUASAR) into system-dependant format
!Argument:
!PRO: protection bit field from EQ.
!Returns: protection digit
BEGIN
MAP PRO: EX;	!Treat this like an EX field, sort of
PRO<27,8>=.PRO;	!Copy the bits into the right place
PRO[XB$CNG]=.PRO<8,1>;	!Get the "change protection" bit
!PRO[XB$EXT]=.PRO<8,1>;	!this goes here if XB$CNG moves to bit 7
PRO<0,18>=0;	!Clear the rest of it
PRO_DS(.PRO)	!Thus reformatted, call the following routine...
END; !PRO_QS

GLOBAL ROUTINE PRO_QD(QP)=
BEGIN
!Convert a 9-bit protetion byte from queue entry to DAP EX format

!
! Formal Parameters
!

!QP: 9-bit protection byte, right justified

!
! Returned value
!

!  A one-word (2-byte) EX field


!
! Locals
!

LOCAL	EXF: EX[3],			!Build it here
	EXFPTR;				!Byte pointer

EXF=0;
EXFPTR=CH$PTR(EXF,0,9);
CH$WCHAR_A( (.QP AND %O'177'),EXFPTR);	!Write the low 7 bits
IF (QP=.QP ^ -8) NEQ 0			!And the rest, if anything
THEN	BEGIN
	EXF[7]=1;			!Set the extension bit
	CH$WCHAR_A(.QP,EXFPTR);		!And write the other byte
	END;
.EXF					!Return this as our value
END;	!PRO_QD

GLOBAL ROUTINE PRO_DS(PRO)=
!Convert DAP format protection field to internal format
!Argument:
!PRO:	Protection field (EX-3) from DAP
!Returns: protection digit to store
BEGIN
MAP PRO: EX;

!Grant the access requested plus as little additional as the o.s will let us
IF .PRO[XB$CNG]
 THEN	BEGIN	!Can't change protection, code must be at least 1
	IF .PRO[XB$DLE]
	 THEN	BEGIN	!Can't delete (so can't rename) code>1
		IF .PRO[XB$WRV]
		 THEN	BEGIN	!Can't write (supercede) code>2
			IF .PRO[XB$UPD]
			 THEN	BEGIN !Can't update, code >3
				IF .PRO[XB$APP] OR .PRO[XB$EXT]
				 THEN	BEGIN	!Cant append, code>4
					IF .PRO[XB$RDV]
					 THEN	BEGIN	!Can't read, code 6 or 7
						IF .PRO[XB$EXE]
						 THEN 7	!No access at all
						 ELSE 6	!Execute only
						END
					 ELSE 5	!Read, execute
					END
				 ELSE 4	!Append, read, execute
				END
			 ELSE 3	!Update, append, read, execute
			END
		 ELSE 2	!Supercede, update, append, read, execute
		END
	 ELSE 1	!Rename, supercede, update, append, read, execute
	END
 ELSE 0	!Everything
END;
%FI	!End FTNETSPL

GLOBAL ROUTINE PRO_SD(PRO)=
!Convert internal format protection field to DAP format
!PRO: protection digit in binary
!Returns: the extensible field stored in EX structure format

BEGIN
%IF FTRMCOPY %THEN
LITERAL		!BIT DEFINITIONS IN DAP PROTECTION FIELDS

	XB$RDV=0,		! DENY READ ACCESS
	XB$WRV=1,		! DENY WRITE ACCESS
	XB$EXE=2,		! DENY EXECUTE ACCESS
	XB$DLE=3,		! DENY DELETE ACCESS
	XB$APP=4,		! DENY APPEND ACCESS
	XB$LST=5,		! DENY LIST (directory) ACCESS
	XB$UPD=6,		! DENY UPDATE ACCESS
	XB$CNG=8;		! DENY CHANGE PROTECTION ACCESS
!LITERAL XB$EXT=9;		! DENY EXTEND ACCESS
MACRO EX(FOO)=BITVECTOR[FOO*8]%;
%FI	!End FTRMCOPY

LOCAL R: EX[3];

R=0;		!Allow everything to start with
SELECT .PRO OF
	SET
	[1 TO 7]:	R[XB$CNG]=1;	!Can't change attributes
	[2 TO 7]:	R[XB$DLE]=1;	!Can't delete it
	[3 TO 7]:	R[XB$WRV]=1;	!Can't supercede it
	[4 TO 7]:	R[XB$UPD]=1;	!Can't update it
	[5 TO 7]:	%IF %DECLARED(XB$EXT) %THEN
			R[XB$EXT]=
			%FI
			(R[XB$APP]=1); !Can't append to it
	[6 TO 7]:	R[XB$RDV]=1;	!Can't read it
	[7]:		R[XB$EXE]=1;	!Can't execute it
	TES;
R[XB$LST]=(NOT .PRO) AND 1;	!Set this in case this is a directory

.R
END;

%IF NOT FTRMCOPY %THEN
GLOBAL ROUTINE DAT_DS(NB,DATATYPE)=
!Convert DATATYPE field from DAP and store it in file block
!Arguments:
!FB:	file block
!DATATYPE: DATATYPE field from DAP
BEGIN
MAP DATATYPE: REF EX;	!Extensible field
MAP NB: REF NDB;
BIND FB=N[FB]: REF FILE_BLOCK;
IF .DATATYPE[DAT$ASC] THEN FB[FILE$MODE]=_IOASC	!Mode 0= Ascii
		ELSE FB[FILE$MODE]=_IOIMG;	!Mode 10= Image
END;

GLOBAL ROUTINE DAT_SD(NB,DATATYPE)=
!Generate appropriate DATATYPE field from file block & return as value
!Argument:
!NB:	node block
!DATATYPE: addr to store it in
!Returns: DATATYPE field
BEGIN
MAP DATATYPE: REF EX[2];
MAP NB: REF NDB;
BIND FB=N[FB]: REF FILE_BLOCK;
	IF (.N[OSTYPE] NEQ DAP$TOPS10) AND (.N[OSTYPE] NEQ DAP$TOPS20) AND
	(.N[RMC$O_B16P]+.N[RMC$O_B36]+.N[RMC$O_B16I] EQL 0)
	THEN	DATATYPE[DAT$ASC]=1
	ELSE	DATATYPE[DAT$IMA]=1;
				!Default to ASCII block mode
				!Unless this is TOPS-10 or TOPS-20
..DATATYPE
END;
GLOBAL ROUTINE DTE_SD(PTR,SDATE)=
!Convert system date to DAP format
!PTR: addr of byte pointer to write DAP format DATE 		dd-mmm-yy
!SDATE: TOPS-10 format date
BEGIN
LOCAL
	DD,MMM,YY;

YY=64+(.SDATE/(12*31));	!Get year (last 2 digits anyway)
MMM=(.SDATE/31) MOD 12;		!Get month number
DD=(.SDATE MOD 31)+1;		!and day of month

WRNM2A(.DD,10,.PTR);		!Write day of month
CH$WCHAR_A(%C'-',.PTR);		!-
.PTR=CH$MOVE(3,CH$PTR(MONTAB[.MMM]),..PTR);	!month (3 letter abbreviation)
CH$WCHAR_A(%C'-',.PTR);		!-
WRNM2A(.YY,10,.PTR);		!and 2 digits of year
END;	!DAT_SD

GLOBAL ROUTINE TIM_SD(PTR,STIME)=
!Convert milliseconds-past-midnight to DAP format	hh:mm:ss
!PTR: addr of b.p. to write dap format TIME
!STIME: # of milliseconds since midnight
BEGIN
LOCAL
	HH,MM,SS;

SS=(STIME=(.STIME/1000)) MOD 60;!Seconds
HH=.STIME/(60*60);		!Hours
MM=(.STIME/60) MOD 60;		!Minutes

WRNM2A(.HH,10,.PTR);		!Hours
CH$WCHAR_A(%C':',.PTR);		!:
WRNM2A(.MM,10,.PTR);		!Minutes
CH$WCHAR_A(%C':',.PTR);		!:
WRNM2A(.SS,10,.PTR);		!Seconds

END;	!TIM_SD

GLOBAL ROUTINE WRDTM(PTR)=
!Write date&time stamp thru pointer
!PTR:  byte pointer
!Returns: updated byte pointer
BEGIN
EXTERNAL ROUTINE
	MSTIME,
	DATE;


DTE_SD(PTR,DATE());	!Date first
CH$WCHAR_A(%C' ',PTR);	!space
TIM_SD(PTR,MSTIME());	!and time
CH$WCHAR_A(%C' ',PTR);
CH$WCHAR(0,.PTR);	!Make ASCIZ

.PTR		!Return new value of pointer
END;	!WRDTM

GLOBAL ROUTINE TSTAMP=
!write date&time stamp to LOG file
BEGIN
EXTERNAL ROUTINE
	LOGS;

OWN
	BUFF:VECTOR[CH$ALLOCATION(24)];
LOCAL
	PTR;

PTR=CH$PTR(BUFF);
WRDTM(.PTR);		!Convert date & time to ASCII
LOGS(BUFF);		!send to log file

END;	!TSTAMP

GLOBAL ROUTINE WRNM2A(NUM,RAD,PTR)=
!Write a 2 digit non-zero-supressed number
!NUM: value to write
!RAD: radix
!PTR: address of byte pointer
BEGIN
CH$WCHAR_A(((.NUM/.RAD) MOD .RAD)+%C'0',.PTR);
CH$WCHAR_A((.NUM MOD .RAD)+%C'0',.PTR);
END;

GLOBAL ROUTINE WRNUMF(NUM,RAD,PTR,FILL,LEN)=
!Convert an integer to ASCII and fill out to a fixed length
!Number will be right-justified in field, if it fits in the field
!Creates ASCIZ string, returning pointer to the null byte at the end
! so that subsequent writing to that string does not leave imbedded null bytes
!IF THE NUMBER IS TOO BIG TO FIT IT WILL ALL BE WRITTEN ANYWAY

!
! Formal Parameters
!
!NUM:	Integer to convert to ASCII
!RAD:	Radix for conversion
!	If negative do signed conversion, else do unsigned
!	Use absolute value for radix in either case
!PTR:	Destination byte pointer
!FILL:	ASCII character to fill field out to specified length
!LEN:	Length of field

!
! Returned value
!
!Pointer to null byte at end of string

BEGIN
LOCAL	BUFF: VECTOR[CH$ALLOCATION(14)],	!Buffer to save ASCII number
	L;					!Length of ASCII number

L=WRNUM(.NUM,.RAD,CH$PTR(BUFF));	!Convert number and store in BUFF
					!L now contains # of characters needed
IF (.LEN-.L) GTR 0
 THEN	PTR=CH$FILL(.FILL,(.LEN-.L),.PTR); !Put in fillers if needed

MOVEAZ(%REF(CH$PTR(BUFF)),PTR);		!Copy ASCII number to right place
.PTR					!Return updated pointer
END; !WRNUMF

GLOBAL ROUTINE FIXIMG(NB,FB)=
!Avoid extending image-mode file by 1 word if length is odd
BEGIN
MAP	NB: REF NDB,		!Not referenced currently
	FB: REF FILE_BLOCK;

IF (.(FB[FILE$O_PTR])<30,6> EQL 32) AND (.FB[FILE$MODE] EQL _IOIMG)
THEN
	BEGIN
	FB[FILE$O_PTR]=.FB[FILE$O_PTR]-%O'320000000001';
	FB[FILE$O_COUNT]=.FB[FILE$O_COUNT]+1;
	END;
END;
%FI !End NOT FTRMCOPY

END ELUDOM