seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-12-09 23:03:02 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/abs.mar Normal file
View File

@@ -0,0 +1,36 @@
.TITLE ABS. PLM RUNTIME LIBRARY: ABS
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; X = ABS(Y)
;
Y=4 ; REAL.
.ENTRY ABS.,^M<>
BICL3 #^X8000,Y(AP),R0
RET
.END

285
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/argument.plm Normal file
View File

@@ -0,0 +1,285 @@
$TITLE ("UDI Procedures to Get Command Arguments")
$LARGE OPTIMIZE(3)
DQ_argument: do; /* UDI procedures to get command arguments. */
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*-----------------------------------------------------------------------*/
/* */
/* R E V I S I O N H I S T O R Y */
/* */
/* 07JAN82 Alex Hunter 1. Changed default delimiter set to */
/* agree with Series III default. */
/* 2. Added DQ$SET$DELIMITERS procedure. */
/* 31JAN82 Alex Hunter 1. Added indirect command lines. */
/* 03FEB82 Alex Hunter 1. Changed module name. */
/* 05FEB82 Alex Hunter 1. Only allow @file from invocation line.*/
/* 07FEB82 Alex Hunter 1. Fix bug for zero-length indirect */
/* files. */
/* */
/*************************************************************************/
declare %PTR literally 'POINTER';
$INCLUDE (PLM$UDI:CUSTOMARY.LIT)
$INCLUDE (PLM$UDI:ASCII.LIT)
$INCLUDE (PLM$UDI:EXCEPT.LIT)
$INCLUDE (PLM$UDI:EXITCODES.LIT)
$INCLUDE (PLM$UDI:DESCRIPT.LIT)
/**************** EXTERNAL UDI ROUTINES ********************/
DECLARE CONNECTION literally 'WORD';
DQ$ATTACH: PROCEDURE (path$p,excep$p) CONNECTION EXTERNAL;
DECLARE (path$p,excep$p) POINTER;
END;
DQ$DETACH: PROCEDURE (conn,excep$p) EXTERNAL;
DECLARE conn CONNECTION, excep$p POINTER;
END;
DQ$EXIT: PROCEDURE (completion$code) EXTERNAL;
DECLARE completion$code WORD;
END;
DQ$OPEN: PROCEDURE (conn,access,num$buf,excep$p) EXTERNAL;
DECLARE conn CONNECTION, access BYTE, num$buf BYTE,
excep$p POINTER;
END;
DQ$READ: PROCEDURE (conn,buf$p,count,excep$p) WORD EXTERNAL;
DECLARE conn CONNECTION, buf$p POINTER, count WORD,
excep$p POINTER;
END;
/*********************************************/
declare CR literally 'ASC$CR', LF literally 'ASC$LF',
TAB literally 'ASC$HT';
LIB%GET_FOREIGN: procedure (tail$d,prompt$d,outlen$p) external;
declare (tail$d,prompt$d,outlen$p) pointer;
end;
common /command_tail/ tail (256) byte;
declare tail$desc descriptor
data (size(tail)-1,DSC$K_DTYPE_T,DSC$K_CLASS_S,@tail);
declare prompt (*) byte data ('$_Command_tail: ');
declare prompt$desc descriptor
data (size(prompt),DSC$K_DTYPE_T,DSC$K_CLASS_S,@prompt);
declare i word;
declare initialized byte initial(FALSE);
declare command$buf$p pointer;
declare (command based command$buf$p) (1) byte;
declare default$delimiter$set (*) byte data
(20, ',()=#!$%\~+-&|[]<>;', ASC$DEL);
declare current$delimiter$set$p pointer initial (@default$delimiter$set);
declare (current$delimiter$set based current$delimiter$set$p) (1) byte;
declare indirect$buffer (4097) byte;
declare indirect$file$name (81) byte;
declare parsing$indirect$file byte initial (FALSE);
declare parsing$invocation$line byte initial (FALSE);
$subtitle ("DQ$GET$ARGUMENT -- Get Command Argument")
DQ$GET$ARGUMENT: procedure (argument$p, excep$p) byte reentrant public;
declare (argument$p, excep$p) %PTR;
declare (argument based argument$p) structure (length byte,
arg(80) byte);
declare (status based excep$p) word;
declare quote byte;
declare terminator byte;
declare conn word;
declare local$status word;
declare buffer$length word;
declare count word;
declare index word;
delimiter: procedure byte;
if command(i) <= 20H or
FINDB(@current$delimiter$set(1),command(i),
current$delimiter$set(0)) <> 0FFFFH
then
return TRUE;
else
return FALSE;
end delimiter;
putc: procedure (char);
declare char byte;
if argument.length < 80 then do;
argument.arg(argument.length)=char;
argument.length=argument.length+1;
end;
else
status = E$STRING$BUF;
return;
end putc;
status = E$OK;
argument.length = 0;
if not initialized then do;
declare outlen word;
call LIB%GET_FOREIGN (@tail$desc,
@prompt$desc,@outlen);
tail(outlen)=CR;
command$buf$p = tail$desc.ptr;
i = 0;
initialized = TRUE;
parsing$invocation$line=TRUE;
end;
rescan:
do while command(i)=' ' or command(i)=tab; i=i+1; end;
if parsing$invocation$line and command(i)='@' then
do;
if parsing$indirect$file then
call DQ$EXIT(X$bad$indirect$syntax);
endif
i=i+1;
parsing$indirect$file=TRUE;
terminator=DQ$GET$ARGUMENT(@indirect$file$name,@local$status);
parsing$indirect$file=FALSE;
if terminator<>CR then
call DQ$EXIT(X$indirect$not$last);
endif
conn=DQ$ATTACH(@indirect$file$name,@local$status);
if local$status<>E$OK then
call DQ$EXIT(X$bad$indirect$file);
endif
call DQ$OPEN(conn,1,1,@local$status);
if local$status<>E$OK then
call DQ$EXIT(X$bad$indirect$file);
endif
buffer$length=0;
count=1;
do while count>0 and buffer$length<size(indirect$buffer);
count=DQ$READ(conn,@indirect$buffer(buffer$length),
size(indirect$buffer)-buffer$length,
@local$status);
if local$status<>E$OK then
call DQ$EXIT(X$bad$indirect$file);
endif
buffer$length=buffer$length+count;
enddo
if buffer$length>=size(indirect$buffer) then
call DQ$EXIT(X$indirect$too$long);
endif
call DQ$DETACH(conn,@local$status);
if local$status<>E$OK then
call DQ$EXIT(X$bad$indirect$file);
endif
do index=1 to buffer$length;
if indirect$buffer(index-1)=CR or
indirect$buffer(index-1)=LF then
indirect$buffer(index-1)=' ';
endif
enddo
indirect$buffer(buffer$length)=CR;
command$buf$p = @indirect$buffer;
i = 0;
go to rescan;
enddo
endif
if delimiter then do;
i=i+1;
return command(i-1);
end;
if command(i)='''' or command(i)='"' then do;
quote = command(i);
do while command(i)=quote;
i=i+1;
do while command(i)<>quote and command(i)<>CR;
call putc(command(i));
i=i+1;
end;
if command(i)<>CR then i=i+1;
if command(i)=quote then call putc(quote);
end;
end;
else do while not delimiter;
if command(i)>='a' and command(i)<='z' then
call putc(command(i)+('A'-'a'));
else
call putc(command(i));
i=i+1;
end;
do while command(i)=' ' or command(i)=tab; i=i+1; end;
if delimiter then do;
i=i+1;
return command(i-1);
end;
else
return ' ';
end DQ$GET$ARGUMENT;
$subtitle ("DQ$SWITCH$BUFFER -- Change Command Buffer")
DQ$SWITCH$BUFFER: procedure (buffer$p, excep$p) word public;
declare (buffer$p, excep$p) %PTR;
declare (status based excep$p) word;
declare OLD$I word;
command$buf$p = buffer$p;
OLD$I = i; i = 0;
initialized = TRUE;
parsing$invocation$line = FALSE;
status = E$OK;
return OLD$I;
end DQ$SWITCH$BUFFER;
$subtitle ("DQ$SET$DELIMITERS -- Change Delimiter Set")
DQ$SET$DELIMITERS: procedure (delimiter$set$p, excep$p) public;
declare (delimiter$set$p, excep$p) %PTR;
declare (status based excep$p) word;
if delimiter$set$p = 0 then
current$delimiter$set$p = @default$delimiter$set;
else
current$delimiter$set$p = delimiter$set$p;
status = E$OK;
end DQ$SET$DELIMITERS;
end DQ_argument;

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/ascii.lit Normal file
View File

@@ -0,0 +1,38 @@
/* Non-printing ASCII character literal declarations. */
$SAVE NOLIST
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
declare
ASC$NUL literally '00H',
ASC$BEL literally '07H',
ASC$BS literally '08H',
ASC$HT literally '09H',
ASC$LF literally '0AH',
ASC$VT literally '0BH',
ASC$FF literally '0CH',
ASC$CR literally '0DH',
ASC$ESC literally '1BH',
ASC$DEL literally '7FH';
$RESTORE

74
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/change.plm Normal file
View File

@@ -0,0 +1,74 @@
$TITLE ('UDI Change Extension Routine')
$LARGE
DQ_CHANGE$EXTENSION: do; /* UDI DQ$CHANGE$EXTENSION routine. */
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
$INCLUDE (PLM$UDI:CUSTOMARY.LIT)
$INCLUDE (PLM$UDI:EXCEPT.LIT)
declare %PTR literally 'POINTER';
DQ$CHANGE$EXTENSION: procedure (path$p,extension$p,excep$p) public;
declare (path$p,extension$p,excep$p) %PTR;
declare (path based path$p) (46) byte,
(extension based extension$p) (3) byte,
(status based excep$p) byte;
declare inside_directory byte;
declare i integer;
status = E$OK;
inside_directory=FALSE;
i=1;
do while i<=path(0) and (inside_directory or path(i)<>'.');
if path(i)='[' then
inside_directory=TRUE;
else if path(i)=']' then
inside_directory=FALSE;
i=i+1;
end;
i=i-1;
if extension(0)<>' ' then do;
if i>41 then
status = E$STRING$BUF;
else do;
path(i+1)='.';
path(i+2)=extension(0);
path(i+3)=extension(1);
path(i+4)=extension(2);
i=i+4;
end;
end;
path(0)=i;
end DQ$CHANGE$EXTENSION;
end DQ_CHANGE$EXTENSION;

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/close.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$CLOSE to XQ_CLOSE Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_CLOSE: do;
XQ_CLOSE: procedure (conn$p,excep$p) external;
declare (conn$p,excep$p) pointer;
end;
DQ$CLOSE: procedure (conn,excep$p) public;
declare conn word, excep$p pointer;
call XQ_CLOSE(@conn,excep$p);
end;
end DQ_CLOSE;

73
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/cntrlfld.mar Normal file
View File

@@ -0,0 +1,73 @@
.TITLE XQ_GET_CNTRL_FLD
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
;
; This USEROPEN procedure is used by the XQIO package to
; obtain access to SOS and Wylbur-style lines numbers in
; source files. This code has been stolen almost verbatim
; from the VAX-11 FORTRAN User's Guide, section 3.5.9.
;
;-----------------------------------------------------------------------
;
; R E V I S I O N H I S T O R Y
;
;
; 04FEB82 Alex Hunter 1. Original version.
;
;-----------------------------------------------------------------------
$FABDEF ; Define RAB and FAB offsets.
$RABDEF
; Define argument list offsets.
FABOFF=4 ; 1st argument is FAB.
RABOFF=8 ; 2nd argument is RAB.
LUNOFF=12 ; 3rd argument is logical unit.
.ENTRY XQ_GET_CNTRL_FLD, ^M<R2>
MOVL FABOFF(AP),R0 ; Load FAB address to R0.
MOVL RABOFF(AP),R1 ; Load RAB address to R1.
MOVL @LUNOFF(AP),R2 ; Logical unit number to R2.
; Set size of header field into FAB.
MOVB #2,FAB$B_FSZ(R0)
; Set address into RAB.
MOVAW W_LINE_NUMBER[R2],RAB$L_RHB(R1)
$OPEN FAB=@FABOFF(AP) ; Perform the OPEN.
BLBC R0,10$ ; Return immediately if error.
$CONNECT RAB=@RABOFF(AP); Connect stream to file.
10$: RET ; Status value is from the OPEN or
; the CONNECT.
.PSECT XQ_LINE_SEQS,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG
W_LINE_NUMBER:
.BLKW 100
.END

59
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/compares.mar Normal file
View File

@@ -0,0 +1,59 @@
.TITLE COMPARES. PLM RUNTIME LIBRARY: CMPB/CMPW.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; W = CMPB(SOURCE1,SOURCE2,COUNT)
;
SOURCE1=4 ; POINTER.
SOURCE2=8 ; POINTER.
COUNT=12 ; WORD.
.ENTRY CMPB.,^M<R2,R3>
CMPC3 COUNT(AP),@SOURCE1(AP),@SOURCE2(AP)
BNEQ 1$
DECW R0 ; STRINGS EQUAL: RETURN 0FFFFH.
RET
1$: SUBW3 R0,COUNT(AP),R0 ; RETURN INDEX OF FIRST NON-COMPARE.
RET
;
; W = CMPW(SOURCE1,SOURCE2,COUNT)
;
.ENTRY CMPW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$
MOVL SOURCE1(AP),R1
MOVL SOURCE2(AP),R3
2$: CMPW (R1)+,(R3)+
BNEQ 4$
SOBGTR R0,2$
3$: DECW R0 ; STRINGS EQUAL: RETURN 0FFFFH.
RET
4$: SUBW3 R0,COUNT(AP),R0 ; RETURN INDEX OF FIRST NON-COMPARE.
RET
.END

76
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/config.mar Normal file
View File

@@ -0,0 +1,76 @@
.TITLE CONFIGURATION
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.MACRO ALLOCATE STACK=0,-
MEMORY_SIZE=0,-
OVERLAY_DATA=0,-
SELECTOR_SPACE=0
.PSECT $AAA_OVERLAY_DATA,RD,WRT,NOEXE,GBL,CON,LONG
K.==.+^X8000
D$::
D.:: .LONG $OVERLAY
.BLKB OVERLAY_DATA
E$::
E.::
.PSECT $YYY_STACK,RD,WRT,EXE,GBL,CON,LONG
S.BOT:: .BLKB STACK
S.::
STACK.SIZ==STACK
STACK.LEN==STACK
STACK.LAST==STACK-1
.PSECT MEMORY,PIC,OVR,GBL,SHR,NOEXE,RD,WRT,LONG
MEMORY.:: .BLKB MEMORY_SIZE
MEMORY.TOP::
MEMORY.SIZ==MEMORY_SIZE
MEMORY.LEN==MEMORY_SIZE
MEMORY.LAST==MEMORY_SIZE-1
.PSECT $AAA_CGROUP_VECTOR,RD,NOWRT,EXE,GBL,CON
V$::
V.::
.PSECT $OVERLAY_INFO,LONG,RD,NOWRT,NOEXE
$OVERLAY::
.ENDM ALLOCATE
.MACRO OVERLAY NAME,ABBREV
.PSECT $AAA_'ABBREV,RD,WRT,NOEXE,GBL,CON,LONG
D.'ABBREV::
.LONG $OVERLAY
.PSECT $ZZZ_'ABBREV,RD,WRT,NOEXE,GBL,CON,LONG
E.'ABBREV::
.PSECT $OVERLAY_INFO
.ASCIC `%EXTRACT(0,15,NAME)`
NAME.SIZ=%LENGTH(NAME)
.ASCII `%EXTRACT(NAME.SIZ,15,< >)`
.LONG D.'ABBREV,E.'ABBREV
.ENDM OVERLAY
.MACRO END_OVERLAYS
.PSECT $OVERLAY_INFO
.BYTE 0
.ENDM END_OVERLAYS
.END

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/connstat.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$GET$CONNECTION$STATUS Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_GETCONNECTIONSTATUS: do;
XQ_GET$CONNECTION$STATUS: procedure (conn$p,info$p,excep$p) external;
declare (conn$p,info$p,excep$p) pointer;
end;
DQ$GET$CONNECTION$STATUS: procedure (conn,info$p,excep$p) public;
declare conn word, (info$p,excep$p) pointer;
call XQ_GET$CONNECTION$STATUS(@conn,info$p,excep$p);
end;
end DQ_GETCONNECTIONSTATUS;

39
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/customary.lit Normal file
View File

@@ -0,0 +1,39 @@
/* Customary literal declarations. */
$SAVE NOLIST
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/********************************************************************/
/*
/* R E V I S I O N H I S T O R Y
/*
/* 09NOV81 Alex Hunter 1. Removed definitions of %-keywords, since
/* PL/M-VAX V5.7 no longer wants the '%'.
/*
/********************************************************************/
declare TRUE literally '0FFH', FALSE literally '0',
FOREVER literally 'while 1',
ENDDO literally 'END;',
ENDIF literally ' ';
$RESTORE

138
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/decode.plm Normal file
View File

@@ -0,0 +1,138 @@
$TITLE ('UDI DECODE EXCEPTION')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* */
/*-----------------------------------------------------------------------*/
/* */
/* R E V I S I O N H I S T O R Y */
/* */
/* 14JAN82 Alex Hunter 1. Change value of E$SUPPORT per Series III */
/* Programmer's Reference Manual Rev. B. */
/* 2. No longer necessary to use COMMON to */
/* place messages in high core. */
/* 03FEB82 Alex Hunter 1. Change module name. */
/* 2. Implicit dimension for exception, place */
/* in ROM psect. */
/* 3. Change test in search loop. */
/* */
/*************************************************************************/
DQ_DECODE: do;
$INCLUDE (PLM$UDI:EXCEPT.LIT)
declare PTR literally 'POINTER';
declare text literally '(*) byte data';
declare
M$OK text ('OK--Normal completion.'),
M$CONTEXT text ('CONTEXT--Illegal context.'),
M$CROSSFS text ('CROSSFS--Illegal cross volume rename.'),
M$EXIST text ('EXIST--Object does not exist.'),
M$FACCESS text ('FACCESS--File access violation.'),
M$FEXIST text ('FEXIST--File already exists.'),
M$FNEXIST text ('FNEXIST--File does not exist.'),
M$MEM text ('MEM--Insufficient memory.'),
M$NOPEN text ('NOPEN--File is not open.'),
M$OPEN text ('OPEN--File is already open.'),
M$OREAD text ('OREAD--File open for read only.'),
M$OWRITE text ('OWRITE--File open for write only.'),
M$PARAM text ('PARAM--Illegal parameter.'),
M$PTR text ('PTR--Illegal pointer.'),
M$SHARE text ('SHARE--Can''t share file.'),
M$SIX text ('SIX--Too many open connections.'),
M$SPACE text ('SPACE--Directory is full.'),
M$STRING$BUF text ('STRING$BUF--String too long for buffer.'),
M$SUPPORT text ('SUPPORT--Operation not supported.'),
M$SYNTAX text ('SYNTAX--Illegal pathname.'),
M$UNSAT text ('UNSAT--Unresolved external symbols.'),
M$ADDRESS text ('ADDRESS--Bad address in overlay.'),
M$BAD$FILE text ('BAD$FILE--Invalid object file.'),
M$ZERO$DIVIDE text ('ZERO$DIVIDE--Attempt to divide by zero.'),
M$OVERFLOW text ('OVERFLOW--Arithmetic overflow.'),
M$8087 text ('8087--NDP error.'),
M$HUH text ('???--Unrecognized exception code.'),
exception (*) structure (code word, msg$p pointer, msg$size byte)
data ( E$OK, @M$OK, size(M$OK),
E$CONTEXT, @M$CONTEXT, size(M$CONTEXT),
E$CROSSFS, @M$CROSSFS, size(M$CROSSFS),
E$EXIST, @M$EXIST, size(M$EXIST),
E$FACCESS, @M$FACCESS, size(M$FACCESS),
E$FEXIST, @M$FEXIST, size(M$FEXIST),
E$FNEXIST, @M$FNEXIST, size(M$FNEXIST),
E$MEM, @M$MEM, size(M$MEM),
E$NOPEN, @M$NOPEN, size(M$NOPEN),
E$OPEN, @M$OPEN, size(M$OPEN),
E$OREAD, @M$OREAD, size(M$OREAD),
E$OWRITE, @M$OWRITE, size(M$OWRITE),
E$PARAM, @M$PARAM, size(M$PARAM),
E$PTR, @M$PTR, size(M$PTR),
E$SHARE, @M$SHARE, size(M$SHARE),
E$SIX, @M$SIX, size(M$SIX),
E$SPACE, @M$SPACE, size(M$SPACE),
E$STRING$BUF, @M$STRING$BUF, size(M$STRING$BUF),
E$SUPPORT, @M$SUPPORT, size(M$SUPPORT),
/* old E$SUPPORT */ 010BH, @M$SUPPORT, size(M$SUPPORT),
E$SYNTAX, @M$SYNTAX, size(M$SYNTAX),
E$UNSAT, @M$UNSAT, size(M$UNSAT),
E$ADDRESS, @M$ADDRESS, size(M$ADDRESS),
E$BAD$FILE, @M$BAD$FILE, size(M$BAD$FILE),
E$ZERO$DIVIDE, @M$ZERO$DIVIDE, size(M$ZERO$DIVIDE),
E$OVERFLOW, @M$OVERFLOW, size(M$OVERFLOW),
E$8087, @M$8087, size(M$8087),
0FFFFH, @M$HUH, size(M$HUH),
),
preface (*) byte data ('EXCEPTION nnnnH E$'),
hex (*) byte data ('0123456789ABCDEF');
DQ$DECODE$EXCEPTION: procedure (exception$code,message$p,excep$p) public;
declare exception$code word,
(message$p,excep$p) PTR;
declare (message based message$p) (1) byte,
(status based excep$p) word;
declare (i,j) integer;
j=0;
do while exception(j).code<>exception$code and j<last(exception);
j=j+1;
end;
message(0) = size(preface) + exception(j).msg$size;
call MOVB (@preface, @message(1), size(preface));
do i=0 to 3;
message(i+11)=hex(SHR(exception$code,(3-i)*4) AND 0FH);
end;
call MOVB (exception(j).msg$p, @message(size(preface)+1),
exception(j).msg$size);
status=E$OK;
end DQ$DECODE$EXCEPTION;
end DQ_DECODE;

64
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/descript.lit Normal file
View File

@@ -0,0 +1,64 @@
/* VAX data descriptor literal definitions. */
$SAVE NOLIST
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
declare DESCRIPTOR literally
'structure (length word,dtype byte,class byte,ptr pointer)';
declare
DSC$K_DTYPE_Z literally '0',
DSC$K_DTYPE_V literally '1',
DSC$K_DTYPE_BU literally '2',
DSC$K_DTYPE_WU literally '3',
DSC$K_DTYPE_LU literally '4',
DSC$K_DTYPE_QU literally '5',
DSC$K_DTYPE_B literally '6',
DSC$K_DTYPE_W literally '7',
DSC$K_DTYPE_L literally '8',
DSC$K_DTYPE_Q literally '9',
DSC$K_DTYPE_F literally '10',
DSC$K_DTYPE_D literally '11',
DSC$K_DTYPE_FC literally '12',
DSC$K_DTYPE_DC literally '13',
DSC$K_DTYPE_T literally '14',
DSC$K_DTYPE_NU literally '15',
DSC$K_DTYPE_NL literally '16',
DSC$K_DTYPE_NLO literally '17',
DSC$K_DTYPE_NR literally '18',
DSC$K_DTYPE_NRO literally '19',
DSC$K_DTYPE_NZ literally '20',
DSC$K_DTYPE_P literally '21',
DSC$K_DTYPE_ZI literally '22',
DSC$K_DTYPE_ZEM literally '23';
declare
DSC$K_CLASS_S literally '1',
DSC$K_CLASS_D literally '2',
DSC$K_CLASS_A literally '4',
DSC$K_CLASS_P literally '5',
DSC$K_CLASS_PI literally '6',
DSC$K_CLASS_J literally '7',
DSC$K_CLASS_JI literally '8';
$RESTORE

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/detach.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$DETACH to XQ_DETACH Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_DETACH: do;
XQ_DETACH: procedure (conn$p,excep$p) external;
declare (conn$p,excep$p) pointer;
end;
DQ$DETACH: procedure (conn,excep$p) public;
declare conn word, excep$p pointer;
call XQ_DETACH(@conn,excep$p);
end;
end DQ_DETACH;

23
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/disclaim.mar Normal file
View File

@@ -0,0 +1,23 @@
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------

23
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/disclaim.plm Normal file
View File

@@ -0,0 +1,23 @@
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/

7
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/dm.com Normal file
View File

@@ -0,0 +1,7 @@
$SET VERIFY
$!
$! 16FEB82 Alex Hunter 1. Original version.
$!
$MAC/NOLIS/E=D DM
$!
$SET NOVERIFY

25
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/dm.mar Normal file
View File

@@ -0,0 +1,25 @@
.TITLE DM DUMMY MODULE NEEDED TO DEFINE CLUSTER.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.END

58
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/except.for Normal file
View File

@@ -0,0 +1,58 @@
C***********************************************************************
C
C D I S C L A I M E R N O T I C E
C ------------------- -----------
C
C This document and/or portions of the material and data furnished
C herewith, was developed under sponsorship of the U. S. Government.
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
C University, nor their employees, nor their respective contractors,
C subcontractors, or their employees, makes any warranty, express or
C implied, or assumes any liability or responsibility for accuracy,
C completeness or usefulness of any information, apparatus, product
C or process disclosed, or represents that its use will not infringe
C privately-owned rights. Mention of any product, its manufacturer,
C or suppliers shall not, nor is it intended to, imply approval, dis-
C approval, or fitness for any particular use. The U. S. and the
C University at all times retain the right to use and disseminate same
C for any purpose whatsoever. Such distribution shall be made by the
C National Energy Software Center at the Argonne National Laboratory
C and only subject to the distributee furnishing satisfactory proof
C that he has a valid license from the Intel Corporation in effect.
C
C-----------------------------------------------------------------------
C
C R E V I S I O N H I S T O R Y
C
C 14JAN82 Alex Hunter 1. Change value of E$SUPPORT per Series III
C Programmer's Reference Manual Rev. B.
C
C***********************************************************************
PARAMETER
# E$OK = '0000'X,
# E$CONTEXT = '0101'X,
# E$CROSSFS = '0102'X,
# E$EXIST = '0103'X,
# E$FACCESS = '0026'X,
# E$FEXIST = '0020'X,
# E$FNEXIST = '0021'X,
# E$MEM = '0002'X,
# E$NOPEN = '0104'X,
# E$OPEN = '0105'X,
# E$OREAD = '0106'X,
# E$OWRITE = '0107'X,
# E$PARAM = '0108'X,
# E$PTR = '0109'X,
# E$SHARE = '0028'X,
# E$SIX = '010A'X,
# E$SPACE = '0029'X,
# E$STRING$BUF = '0081'X,
# E$SUPPORT = '0023'X,
# E$SYNTAX = '010C'X,
# E$UNSAT = '010E'X,
# E$ADDRESS = '010F'X,
# E$BAD$FILE = '0110'X,
# E$ZERO$DIVIDE = '8000'X,
# E$OVERFLOW = '8001'X,
# E$8087 = '8007'X

63
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/except.lit Normal file
View File

@@ -0,0 +1,63 @@
/* UDI exception codes. */
$SAVE NOLIST
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*-----------------------------------------------------------------------*/
/* */
/* R E V I S I O N H I S T O R Y */
/* */
/* 14JAN82 Alex Hunter 1. Change value of E$SUPPORT per Series III */
/* Programmer's Reference Manual Rev. B. */
/* */
/*************************************************************************/
declare
E$OK literally '0000H',
E$CONTEXT literally '0101H',
E$CROSSFS literally '0102H',
E$EXIST literally '0103H',
E$FACCESS literally '0026H',
E$FEXIST literally '0020H',
E$FNEXIST literally '0021H',
E$MEM literally '0002H',
E$NOPEN literally '0104H',
E$OPEN literally '0105H',
E$OREAD literally '0106H',
E$OWRITE literally '0107H',
E$PARAM literally '0108H',
E$PTR literally '0109H',
E$SHARE literally '0028H',
E$SIX literally '010AH',
E$SPACE literally '0029H',
E$STRING$BUF literally '0081H',
E$SUPPORT literally '0023H',
E$SYNTAX literally '010CH',
E$UNSAT literally '010EH',
E$ADDRESS literally '010FH',
E$BAD$FILE literally '0110H',
E$ZERO$DIVIDE literally '8000H',
E$OVERFLOW literally '8001H',
E$8087 literally '8007H';
$RESTORE

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/exit.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$EXIT to XQ_EXIT Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_EXIT: do;
XQ_EXIT: procedure (completion$code$p) external;
declare completion$code$p pointer;
end;
DQ$EXIT: procedure (completion$code) public;
declare completion$code word;
call XQ_EXIT(@completion$code);
end;
end DQ_EXIT;

45
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/exitcodes.lit Normal file
View File

@@ -0,0 +1,45 @@
/* UDI exit completion codes. */
$SAVE NOLIST
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*-----------------------------------------------------------------------*/
/* */
/* R E V I S I O N H I S T O R Y */
/* */
/* 31JAN82 Alex Hunter 1. Written. */
/* */
/*************************************************************************/
declare
X$OK literally '0',
X$warnings literally '1',
X$errors literally '2',
X$fatal literally '3',
X$abort literally '4',
X$bad$indirect$syntax literally '101',
X$indirect$not$last literally '102',
X$bad$indirect$file literally '103',
X$indirect$too$long literally '104';
$RESTORE

90
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/finds.mar Normal file
View File

@@ -0,0 +1,90 @@
.TITLE FINDS. PLM RUNTIME LIBRARY: FINDB., ET AL.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; W = FINDB(SOURCE,TARGET,COUNT)
;
SOURCE=4 ; POINTER.
TARGET=8 ; BYTE OR WORD.
COUNT=12 ; WORD.
.ENTRY FINDB.,^M<>
LOCC TARGET(AP),COUNT(AP),@SOURCE(AP)
BNEQ 1$
DECW R0 ; NOT FOUND: RETURN 0FFFFH.
RET
1$: SUBW3 R0,COUNT(AP),R0 ; FOUND: RETURN STRING INDEX.
RET
;
; W = FINDRB(SOURCE,TARGET,COUNT)
;
.ENTRY FINDRB.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; NOT FOUND IF LENGTH=0.
ADDL3 R0,SOURCE(AP),R1
MOVB TARGET(AP),R3
2$: CMPB R3,-(R1)
BEQL 3$
SOBGTR R0,2$
3$: DECW R0 ; RETURN STR INDEX (FFFF IF NOT FOUND).
RET
;
; W = FINDW(SOURCE,TARGET,COUNT)
;
.ENTRY FINDW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; NOT FOUND IF LENGTH=0.
MOVL SOURCE(AP),R1
MOVW TARGET(AP),R3
2$: CMPW R3,(R1)+
BEQL 4$
SOBGTR R0,2$
3$: DECW R0 ; NOT FOUND: RETURN 0FFFFH.
RET
4$: SUBW3 R0,COUNT(AP),R0 ; FOUND: RETURN STRING INDEX.
RET
;
; W = FINDRW(SOURCE,TARGET,COUNT)
;
.ENTRY FINDRW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; NOT FOUND IF LENGTH=0.
ADDL3 R0,SOURCE(AP),R1
ADDL2 R0,R1
MOVW TARGET(AP),R3
2$: CMPW R3,-(R1)
BEQL 3$
SOBGTR R0,2$
3$: DECW R0 ; RETURN STR INDEX (FFFF IF NOT FOUND).
RET
.END

76
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/gettime.plm Normal file
View File

@@ -0,0 +1,76 @@
$TITLE ('UDI GET TIME SYSTEM CALL')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_GET$TIME: do;
$INCLUDE (PLM$UDI:EXCEPT.LIT)
declare PTR literally 'POINTER';
FOR%DATE: procedure (date$p) external;
declare date$p pointer;
end;
FOR%TIME: procedure (time$p) external;
declare time$p pointer;
end;
declare month (12) structure (name(3) byte, number(2) byte)
data( 'JAN01', 'FEB02', 'MAR03',
'APR04', 'MAY05', 'JUN06',
'JUL07', 'AUG08', 'SEP09',
'OCT10', 'NOV11', 'DEC12');
DQ$GET$TIME: procedure (dt$p, excep$p) public;
declare (dt$p,excep$p) PTR;
declare (dt based dt$p) structure (date(8) byte, time(8) byte);
declare (status based excep$p) word;
declare i integer;
call FOR%DATE(@dt.date(7));
i=0;
do while dt.date(10)<>month(i).name(0) or
dt.date(11)<>month(i).name(1) or
dt.date(12)<>month(i).name(2);
i=i+1;
end;
dt.date(0)=month(i).number(0); /* MM */
dt.date(1)=month(i).number(1);
dt.date(2),dt.date(5)='/';
dt.date(3)=dt.date(7) OR '0'; /* DD */
dt.date(4)=dt.date(8);
dt.date(6)=dt.date(14); /* YY */
dt.date(7)=dt.date(15);
call FOR%TIME(@dt.time); /* HH:MM:SS */
status=E$OK;
end DQ$GET$TIME;
end DQ_GET$TIME;

53
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/hilo.mar Normal file
View File

@@ -0,0 +1,53 @@
.TITLE HILO. PLM RUNTIME LIBRARY: HIGH, LOW, DOUBLE.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; B = HIGH(WORD)
;
WORD=4 ; WORD VALUE.
BYTE=4 ; BYTE VALUE.
.ENTRY HIGH.,^M<>
MOVZBL WORD+1(AP),R0
RET
;
; B = LOW(WORD)
;
.ENTRY LOW.,^M<>
MOVZBL WORD(AP),R0
RET
;
; W = DOUBLE(BYTE)
;
.ENTRY DOUBLE.,^M<>
MOVZBL BYTE(AP),R0
RET
.END

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/iabs.mar Normal file
View File

@@ -0,0 +1,38 @@
.TITLE IABS. PLM RUNTIME LIBRARY: IABS
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; I = IABS(J)
;
J=4 ; (LONG)WORD.
.ENTRY IABS.,^M<>
MOVL J(AP),R0
BGEQ 1$
MNEGL R0,R0
1$: RET
.END

177
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/iodef.for Normal file
View File

@@ -0,0 +1,177 @@
PARAMETER IO$V_FCODE = '00000000'X
PARAMETER IO$_NOP = '00000000'X
PARAMETER IO$_UNLOAD = '00000001'X
PARAMETER IO$_LOADMCODE = '00000001'X
PARAMETER IO$_STARTMPROC = '00000002'X
PARAMETER IO$_SEEK = '00000002'X
PARAMETER IO$_SPACEFILE = '00000002'X
PARAMETER IO$_RECAL = '00000003'X
PARAMETER IO$_STOP = '00000003'X
PARAMETER IO$_INITIALIZE = '00000004'X
PARAMETER IO$_DRVCLR = '00000004'X
PARAMETER IO$_SETCLOCKP = '00000005'X
PARAMETER IO$_RELEASE = '00000005'X
PARAMETER IO$V_DELDATA = '00000006'X
PARAMETER IO$V_CANCTRLO = '00000006'X
PARAMETER IO$V_SETEVF = '00000006'X
PARAMETER IO$_ERASETAPE = '00000006'X
PARAMETER IO$S_FCODE = '00000006'X
PARAMETER IO$V_TYPEAHDCNT = '00000006'X
PARAMETER IO$_STARTDATAP = '00000006'X
PARAMETER IO$_OFFSET = '00000006'X
PARAMETER IO$V_NOECHO = '00000006'X
PARAMETER IO$V_INTERRUPT = '00000006'X
PARAMETER IO$V_WORD = '00000006'X
PARAMETER IO$V_STARTUP = '00000006'X
PARAMETER IO$V_NOW = '00000006'X
PARAMETER IO$V_BINARY = '00000006'X
PARAMETER IO$V_ACCESS = '00000006'X
PARAMETER IO$V_REVERSE = '00000006'X
PARAMETER IO$V_COMMOD = '00000006'X
PARAMETER IO$V_READATTN = '00000007'X
PARAMETER IO$V_ENABLMBX = '00000007'X
PARAMETER IO$V_PACKED = '00000007'X
PARAMETER IO$V_TIMED = '00000007'X
PARAMETER IO$V_MOVETRACKD = '00000007'X
PARAMETER IO$V_RESET = '00000007'X
PARAMETER IO$V_CREATE = '00000007'X
PARAMETER IO$V_NOWAIT = '00000007'X
PARAMETER IO$V_SHUTDOWN = '00000007'X
PARAMETER IO$V_CTRLYAST = '00000007'X
PARAMETER IO$_RETCENTER = '00000007'X
PARAMETER IO$_QSTOP = '00000007'X
PARAMETER IO$V_WRTATTN = '00000008'X
PARAMETER IO$V_ATTNAST = '00000008'X
PARAMETER IO$V_CTRLCAST = '00000008'X
PARAMETER IO$V_DELETE = '00000008'X
PARAMETER IO$V_DIAGNOSTIC = '00000008'X
PARAMETER IO$V_INTSKIP = '00000008'X
PARAMETER IO$V_NOFORMAT = '00000008'X
PARAMETER IO$_PACKACK = '00000008'X
PARAMETER IO$V_CVTLOW = '00000008'X
PARAMETER IO$V_ABORT = '00000008'X
PARAMETER IO$_SPACERECORD = '00000009'X
PARAMETER IO$V_HANGUP = '00000009'X
PARAMETER IO$V_SETFNCT = '00000009'X
PARAMETER IO$V_SKPSECINH = '00000009'X
PARAMETER IO$V_SYNCH = '00000009'X
PARAMETER IO$V_OPPOSITE = '00000009'X
PARAMETER IO$_SEARCH = '00000009'X
PARAMETER IO$V_NOFILTR = '00000009'X
PARAMETER IO$V_MOUNT = '00000009'X
PARAMETER IO$V_DSABLMBX = '0000000A'X
PARAMETER IO$_WRITECHECK = '0000000A'X
PARAMETER IO$V_DMOUNT = '0000000A'X
PARAMETER IO$V_DATAPATH = '0000000A'X
PARAMETER IO$V_SWAP = '0000000A'X
PARAMETER IO$V_CECYL = '0000000A'X
PARAMETER IO$_WRITEPBLK = '0000000B'X
PARAMETER IO$V_PURGE = '0000000B'X
PARAMETER IO$V_INHERLOG = '0000000B'X
PARAMETER IO$V_CYCLE = '0000000C'X
PARAMETER IO$V_INHSEEK = '0000000C'X
PARAMETER IO$V_TRMNOECHO = '0000000C'X
PARAMETER IO$V_INHEXTGAP = '0000000C'X
PARAMETER IO$_READPBLK = '0000000C'X
PARAMETER IO$V_REFRESH = '0000000D'X
PARAMETER IO$_WRITEHEAD = '0000000D'X
PARAMETER IO$V_DATACHECK = '0000000E'X
PARAMETER IO$_READHEAD = '0000000E'X
PARAMETER IO$_WRITETRACKD = '0000000F'X
PARAMETER IO$V_INHRETRY = '0000000F'X
PARAMETER IO$_READTRACKD = '00000010'X
PARAMETER IO$_REREADN = '00000016'X
PARAMETER IO$_REREADP = '00000017'X
PARAMETER IO$_WRITERET = '00000018'X
PARAMETER IO$_WRITECHECKH = '00000018'X
PARAMETER IO$_READPRESET = '00000019'X
PARAMETER IO$_STARTSPNDL = '00000019'X
PARAMETER IO$_SETCHAR = '0000001A'X
PARAMETER IO$_SENSECHAR = '0000001B'X
PARAMETER IO$_WRITEMARK = '0000001C'X
PARAMETER IO$_DIAGNOSE = '0000001D'X
PARAMETER IO$_WRTTMKR = '0000001D'X
PARAMETER IO$_FORMAT = '0000001E'X
PARAMETER IO$_CLEAN = '0000001E'X
PARAMETER IO$_PHYSICAL = '0000001F'X
PARAMETER IO$_WRITELBLK = '00000020'X
PARAMETER IO$_READLBLK = '00000021'X
PARAMETER IO$_REWINDOFF = '00000022'X
PARAMETER IO$_SETMODE = '00000023'X
PARAMETER IO$_REWIND = '00000024'X
PARAMETER IO$_SKIPFILE = '00000025'X
PARAMETER IO$_SKIPRECORD = '00000026'X
PARAMETER IO$_SENSEMODE = '00000027'X
PARAMETER IO$_WRITEOF = '00000028'X
PARAMETER IO$_LOGICAL = '0000002F'X
PARAMETER IO$_WRITEVBLK = '00000030'X
PARAMETER IO$_READVBLK = '00000031'X
PARAMETER IO$_ACCESS = '00000032'X
PARAMETER IO$_CREATE = '00000033'X
PARAMETER IO$_DEACCESS = '00000034'X
PARAMETER IO$_DELETE = '00000035'X
PARAMETER IO$_MODIFY = '00000036'X
PARAMETER IO$_SETCLOCK = '00000037'X
PARAMETER IO$_READPROMPT = '00000037'X
PARAMETER IO$_STARTDATA = '00000038'X
PARAMETER IO$_ACPCONTROL = '00000038'X
PARAMETER IO$_MOUNT = '00000039'X
PARAMETER IO$_TTYREADALL = '0000003A'X
PARAMETER IO$_TTYREADPALL = '0000003B'X
PARAMETER IO$_CONINTREAD = '0000003C'X
PARAMETER IO$_CONINTWRITE = '0000003D'X
PARAMETER IO$M_FCODE = '0000003F'X
PARAMETER IO$_VIRTUAL = '0000003F'X
PARAMETER IO$M_ACCESS = '00000040'X
PARAMETER IO$M_TYPEAHDCNT = '00000040'X
PARAMETER IO$M_INTERRUPT = '00000040'X
PARAMETER IO$M_SETEVF = '00000040'X
PARAMETER IO$M_BINARY = '00000040'X
PARAMETER IO$M_NOECHO = '00000040'X
PARAMETER IO$M_STARTUP = '00000040'X
PARAMETER IO$M_NOW = '00000040'X
PARAMETER IO$M_DELDATA = '00000040'X
PARAMETER IO$M_COMMOD = '00000040'X
PARAMETER IO$M_REVERSE = '00000040'X
PARAMETER IO$M_CANCTRLO = '00000040'X
PARAMETER IO$M_WORD = '00000040'X
PARAMETER IO$M_MOVETRACKD = '00000080'X
PARAMETER IO$M_ENABLMBX = '00000080'X
PARAMETER IO$M_CTRLYAST = '00000080'X
PARAMETER IO$M_TIMED = '00000080'X
PARAMETER IO$M_PACKED = '00000080'X
PARAMETER IO$M_SHUTDOWN = '00000080'X
PARAMETER IO$M_NOWAIT = '00000080'X
PARAMETER IO$M_CREATE = '00000080'X
PARAMETER IO$M_READATTN = '00000080'X
PARAMETER IO$M_RESET = '00000080'X
PARAMETER IO$M_ATTNAST = '00000100'X
PARAMETER IO$M_DELETE = '00000100'X
PARAMETER IO$M_CTRLCAST = '00000100'X
PARAMETER IO$M_WRTATTN = '00000100'X
PARAMETER IO$M_CVTLOW = '00000100'X
PARAMETER IO$M_ABORT = '00000100'X
PARAMETER IO$M_DIAGNOSTIC = '00000100'X
PARAMETER IO$M_INTSKIP = '00000100'X
PARAMETER IO$M_NOFORMAT = '00000100'X
PARAMETER IO$M_OPPOSITE = '00000200'X
PARAMETER IO$M_SETFNCT = '00000200'X
PARAMETER IO$M_HANGUP = '00000200'X
PARAMETER IO$M_SYNCH = '00000200'X
PARAMETER IO$M_MOUNT = '00000200'X
PARAMETER IO$M_SKPSECINH = '00000200'X
PARAMETER IO$M_NOFILTR = '00000200'X
PARAMETER IO$M_DMOUNT = '00000400'X
PARAMETER IO$M_DSABLMBX = '00000400'X
PARAMETER IO$M_DATAPATH = '00000400'X
PARAMETER IO$M_CECYL = '00000400'X
PARAMETER IO$M_SWAP = '00000400'X
PARAMETER IO$M_INHERLOG = '00000800'X
PARAMETER IO$M_PURGE = '00000800'X
PARAMETER IO$M_INHSEEK = '00001000'X
PARAMETER IO$M_INHEXTGAP = '00001000'X
PARAMETER IO$M_CYCLE = '00001000'X
PARAMETER IO$M_TRMNOECHO = '00001000'X
PARAMETER IO$M_REFRESH = '00002000'X
PARAMETER IO$M_DATACHECK = '00004000'X
PARAMETER IO$M_INHRETRY = '00008000'X

9
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/lognames.com Normal file
View File

@@ -0,0 +1,9 @@
$!
$! LOGNAMES.COM
$!
$! Command file to assign system-dependent logical names.
$!
$! 04FEB82 Alex Hunter 1. Original version.
$!
$ASSIGN DISK1:[AFH.VAXLIB.PLMRUN] PLM$UDI ! UDI library directory.
$!

19
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/maketape.com Normal file
View File

@@ -0,0 +1,19 @@
$SET VERIFY
$! MAKETAPE.COM
$!
$!
$! Command file to generate the build-it-from-source kit
$! for the PL/M-VAX runtime library (including the UDI
$! routines).
$!
$! 05FEB82 Alex Hunter 1. Original version.
$! 06APR82 Alex Hunter 1. Allocate MTA0 instead of MT.
$!
$ALLOCATE MTA0 TAPE
$INIT/DENSITY=1600 TAPE PLMUDI
$MOUNT TAPE PLMUDI
$COPY/LOG *.* TAPE
$DIR/SIZ/DAT TAPE
$DISMOUNT TAPE
$DEALLOCATE TAPE
$SET NOVERIFY

39
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/move.mar Normal file
View File

@@ -0,0 +1,39 @@
.TITLE MOVE. PLM RUNTIME LIBRARY: MOVE.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; CALL MOVE(COUNT,SOURCE,DESTINATION)
;
COUNT=4 ; WORD.
SOURCE=8 ; POINTER.
DESTINATION=12 ; POINTER.
PLM$MOVE::
.ENTRY MOVE.,^M<R2,R3,R4,R5>
MOVC3 COUNT(AP),@SOURCE(AP),@DESTINATION(AP)
RET
.END

106
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/moves.mar Normal file
View File

@@ -0,0 +1,106 @@
.TITLE MOVES. PLM RUNTIME LIBRARY: MOVB. ET AL.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; CALL MOVB(SOURCE,DESTINATION,COUNT)
;
SOURCE=4 ; POINTER.
DESTINATION=8 ; POINTER.
COUNT=12 ; WORD.
.ENTRY MOVB.,^M<R2,R3,R4,R5>
CMPL SOURCE(AP),DESTINATION(AP)
BLEQU 1$
;
; NO OVERLAP POSSIBLE.
;
MOVC3 COUNT(AP),@SOURCE(AP),@DESTINATION(AP)
RET
;
; OVERLAP POSSIBLE.
;
1$: MOVZWL COUNT(AP),R0
BEQL 3$
MOVL SOURCE(AP),R1
MOVL DESTINATION(AP),R3
2$: MOVB (R1)+,(R3)+
SOBGTR R0,2$
3$: RET
;
; CALL MOVRB(SOURCE,DESTINATION,COUNT)
;
.ENTRY MOVRB.,^M<R2,R3,R4,R5>
CMPL SOURCE(AP),DESTINATION(AP)
BGEQU 1$
;
; NO OVERLAP POSSIBLE.
;
MOVC3 COUNT(AP),@SOURCE(AP),@DESTINATION(AP)
RET
;
; OVERLAP POSSIBLE.
;
1$: MOVZWL COUNT(AP),R0
BEQL 3$
ADDL3 R0,SOURCE(AP),R1
ADDL3 R0,DESTINATION(AP),R3
2$: MOVB -(R1),-(R3)
SOBGTR R0,2$
3$: RET
;
; CALL MOVW(SOURCE,DESTINATION,COUNT)
;
.ENTRY MOVW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$
MOVL SOURCE(AP),R1
MOVL DESTINATION(AP),R3
2$: MOVW (R1)+,(R3)+
SOBGTR R0,2$
3$: RET
;
; CALL MOVRW(SOURCE,DESTINATION,COUNT)
;
.ENTRY MOVRW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$
ADDL3 R0,SOURCE(AP),R1
ADDL2 R0,R1
ADDL3 R0,DESTINATION(AP),R3
ADDL2 R0,R3
2$: MOVW -(R1),-(R3)
SOBGTR R0,2$
3$: RET
.END

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/open.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$OPEN to XQ_OPEN Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_OPEN: do;
XQ_OPEN: procedure (conn$p,access$p,numbuf$p,excep$p) external;
declare (conn$p,access$p,numbuf$p,excep$p) pointer;
end;
DQ$OPEN: procedure (conn,access,num$buf,excep$p) public;
declare conn word, access byte, num$buf byte, excep$p pointer;
call XQ_OPEN(@conn,@access,@num$buf,excep$p);
end;
end DQ_OPEN;

86
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/overlay.plm Normal file
View File

@@ -0,0 +1,86 @@
$TITLE ('UDI OVERLAY SYSTEM CALL')
$LARGE NOWARN
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_OVERLAY: do;
/*------------------------------------------------------*/
/* */
/* The function of DQ$OVERLAY in the VMS environment */
/* is to copy the local data for the specified */
/* 'overlay' down into the common data overlay area */
/* which has been reserved in the 64K DGROUP address */
/* space. */
/* */
/*------------------------------------------------------*/
$INCLUDE (PLM$UDI:EXCEPT.LIT)
declare D% byte external, /* First byte of overlay data area */
E% byte external; /* Last byte +1 */
declare %overlay(1) structure( /* Supplied by application system */
name(16) byte, /* Overlay name (string) */
start pointer, /* Address of first local data byte */
stop pointer) /* Address of last byte +1 */
external;
DQ$OVERLAY: procedure (name$p,excep$p) public;
declare (name$p,excep$p) pointer;
declare (name based name$p) (1) byte;
declare (status based excep$p) word;
declare i integer;
if name(0) > last(%overlay.name) then
do;
status=E$SYNTAX; /* Overlay name too long. */
return;
end;
i=0;
do while %overlay(i).name(0) <> 0;
if CMPB(%_pointer(name$p),@%overlay(i).name,
%overlay(i).name(0)+1) = 0FFFFH then
do;
if %overlay(i).stop-%overlay(i).start > @E%-@D% then
do;
status=E$ADDRESS; /* Overlay data area too small. */
return;
end;
call MOVE(%overlay(i).stop-%overlay(i).start,
%overlay(i).start,@D%);
status=E$OK;
return;
end;
i=i+1;
end;
status=E$EXIST; /* Overlay name not in table. */
return;
end DQ$OVERLAY;
end DQ_OVERLAY;

11
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/plmmac.bld Normal file
View File

@@ -0,0 +1,11 @@
$SET VERIFY
$!
$! PLMMAC.BLD
$!
$! Command file to build the PLMMAC.MLB macro library.
$!
$! 06FEB82 Alex Hunter 1. Original version.
$!
$LIB/CREATE/MACRO PLMMAC CONFIG
$!
$SET NOVERIFY

55
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/plmrun.bld Normal file
View File

@@ -0,0 +1,55 @@
$SET VERIFY
$!
$! PLMRUN.BLD
$!
$! Command file to build the PL/M-VAX runtime library
$! (including the UDI routines).
$!
$! 05FEB82 Alex Hunter 1. Original version.
$!
$@LOGNAMES
$!
$MAC/LIS/E=D ABS
$MAC/LIS/E=D CNTRLFLD
$MAC/LIS/E=D COMPARES
$MAC/LIS/E=D FINDS
$MAC/LIS/E=D HILO
$MAC/LIS/E=D IABS
$MAC/LIS/E=D MOVE
$MAC/LIS/E=D MOVES
$MAC/LIS/E=D RENAME
$MAC/LIS/E=D SETS
$MAC/LIS/E=D SHIFTS
$MAC/LIS/E=D SKIPS
$MAC/LIS/E=D XLAT
$!
$PLM ARGUMENT DEBUG
$PLM CHANGE DEBUG
$PLM CLOSE DEBUG
$PLM CONNSTAT DEBUG
$PLM DECODE DEBUG
$PLM DETACH DEBUG
$PLM EXIT DEBUG
$PLM GETTIME DEBUG
$PLM OPEN DEBUG
$PLM OVERLAY DEBUG
$PLM READ DEBUG
$PLM SEEK DEBUG
$PLM SPECIAL DEBUG
$PLM SYSTEMID DEBUG
$PLM TRUNCATE DEBUG
$PLM WRITE DEBUG
$!
$FOR/NOLIS/NOCHECK/DEBUG XQIO
$!
$MESS/LIS UDIMSGS
$!
$LIB/CRE PLMRUN -
ABS,CNTRLFLD,COMPARES,FINDS,HILO,IABS,MOVE,-
MOVES,RENAME,SETS,SHIFTS,SKIPS,XLAT,-
ARGUMENT,CHANGE,CLOSE,CONNSTAT,DECODE,DETACH,EXIT,-
GETTIME,OPEN,OVERLAY,READ,SEEK,SPECIAL,SYSTEMID,-
TRUNCATE,WRITE,-
XQIO,-
UDIMSGS
$SET NOVERIFY

44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/read.me Normal file
View File

@@ -0,0 +1,44 @@
February 16, 1982
Alex Hunter
READ.ME
This directory contains the source files, include files, and
command files needed to build the PL/M-VAX runtime library
(including the UDI routines), and the configuration macro library.
The *.PLM, *.MAR, and *.FOR files are source files. The *.LIT,
*.DEF, EXCEPT.FOR, RMSDEF.FOR, IODEF.FOR, and XQCOMMON.FOR files are
include files. (RMSDEF.FOR and IODEF.FOR are copies of parameter
definition files from SYS$LIBRARY. Apparently these files are not
present in all VMS systems.)
UDIMSGS.MSG is the source file for the UDI message facility.
LOGNAMES.COM is a command file containing logical name assignments
used by other command files in this directory. LOGNAMES.COM should
be edited to reflect the directory names in use on your system.
Any command file which makes use of system-dependent logical name
assignments will contain a call to LOGNAMES.COM, so LOGNAMES.COM
should be the only command file requiring editing.
PLMRUN.BLD is a command file to build the PLMRUN.OLB library
from scratch. XQIO.BLD is a command file to rebuild just the
XQIO package.
PLMMAC.BLD is a command file to build the PLMMAC.MLB configuration
macro library from scratch.
DM.MAR is a source file used to produce the dummy (null) object file
DM.OBJ which is referenced by various *.LNK command files to satisfy
the VMS linker's need for an object file specification in the CLUSTER
command. DM.COM is a command file used to assemble DM.MAR.
VMSRTL.V23 is version 2.3 of the VMS shared runtime library. Various
*.LNK command files reference this copy (rather than the currently
installed shared library) in order to produce executable images
which will run under VMS 2.3 (and later).
MAKETAPE.COM is the command file used to write the contents of
this directory to mag tape.

42
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/read.plm Normal file
View File

@@ -0,0 +1,42 @@
$TITLE ('DQ$READ to XQ_READ Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_READ: do;
$INCLUDE (PLM$UDI:DESCRIPT.LIT)
XQ_READ: procedure (conn$p,buf$d$p,excep$p) word external;
declare (conn$p,buf$d$p,excep$p) pointer;
end;
DQ$READ: procedure (conn,buf$p,count,excep$p) word public;
declare conn word, buf$p pointer, count word, excep$p pointer;
declare buf$d descriptor initial(0,DSC$K_DTYPE_T,DSC$K_CLASS_S);
buf$d.length=count; buf$d.ptr=buf$p;
return XQ_READ(@conn,@buf$d,excep$p);
end;
end DQ_READ;

44
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/readme.md Normal file
View File

@@ -0,0 +1,44 @@
February 16, 1982
Alex Hunter
READ.ME
This directory contains the source files, include files, and
command files needed to build the PL/M-VAX runtime library
(including the UDI routines), and the configuration macro library.
The *.PLM, *.MAR, and *.FOR files are source files. The *.LIT,
*.DEF, EXCEPT.FOR, RMSDEF.FOR, IODEF.FOR, and XQCOMMON.FOR files are
include files. (RMSDEF.FOR and IODEF.FOR are copies of parameter
definition files from SYS$LIBRARY. Apparently these files are not
present in all VMS systems.)
UDIMSGS.MSG is the source file for the UDI message facility.
LOGNAMES.COM is a command file containing logical name assignments
used by other command files in this directory. LOGNAMES.COM should
be edited to reflect the directory names in use on your system.
Any command file which makes use of system-dependent logical name
assignments will contain a call to LOGNAMES.COM, so LOGNAMES.COM
should be the only command file requiring editing.
PLMRUN.BLD is a command file to build the PLMRUN.OLB library
from scratch. XQIO.BLD is a command file to rebuild just the
XQIO package.
PLMMAC.BLD is a command file to build the PLMMAC.MLB configuration
macro library from scratch.
DM.MAR is a source file used to produce the dummy (null) object file
DM.OBJ which is referenced by various *.LNK command files to satisfy
the VMS linker's need for an object file specification in the CLUSTER
command. DM.COM is a command file used to assemble DM.MAR.
VMSRTL.V23 is version 2.3 of the VMS shared runtime library. Various
*.LNK command files reference this copy (rather than the currently
installed shared library) in order to produce executable images
which will run under VMS 2.3 (and later).
MAKETAPE.COM is the command file used to write the contents of
this directory to mag tape.

57
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/rename.mar Normal file
View File

@@ -0,0 +1,57 @@
.TITLE XQ___RENAME RENAME OLD_FILE TO NEW_FILE
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
;
;
; INTEGER*4 XQ___RENAME,STATUS
; STATUS = XQ___RENAME(OLD_FILE,NEW_FILE)
;
; WHERE OLD_FILE AND NEW_FILE ARE CHARACTER STRINGS OR EXPRESSIONS,
; AND STATUS WILL RECEIVE THE RMS RESULT CODE.
;
;-----------------------------------------------------------------------
;
; R E V I S I O N H I S T O R Y
;
;
; 03FEB82 Alex Hunter 1. Changed routine and psect names.
;
;-----------------------------------------------------------------------
.PSECT XQ_DATA,RD,WRT,NOEXE,GBL,CON,LONG
FAB.1: $FAB NAM=NAM.1
FAB.2: $FAB NAM=NAM.2
NAM.1: $NAM ESA=ESA.1,ESS=48
NAM.2: $NAM ESA=ESA.2,ESS=48
ESA.1: .BLKB 48
ESA.2: .BLKB 48
.PSECT XQ_CODE,RD,NOWRT,EXE,GBL,CON,LONG
.ENTRY XQ___RENAME,^M<R2>
MOVQ @4(AP),R1 ; GET OLD_FILE DESCRIPTOR.
$FAB_STORE FAB=FAB.1,FNS=R1,FNA=(R2)
MOVQ @8(AP),R1 ; GET NEW_FILE DESCRIPTOR.
$FAB_STORE FAB=FAB.2,FNS=R1,FNA=(R2)
$RENAME OLDFAB=FAB.1,NEWFAB=FAB.2
RET
.END

194
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/rmsdef.for Normal file
View File

@@ -0,0 +1,194 @@
PARAMETER RMS$V_STVSTATUS = '0000000E'X
PARAMETER RMS$_SUC = '00010001'X
PARAMETER RMS$_NORMAL = '00010001'X
PARAMETER RMS$_CONTROLO = '00010609'X
PARAMETER RMS$_CONTROLY = '00010611'X
PARAMETER RMS$_CREATED = '00010619'X
PARAMETER RMS$_SUPERSEDE = '00010631'X
PARAMETER RMS$_CONTROLC = '00010651'X
PARAMETER RMS$_STALL = '00018001'X
PARAMETER RMS$_PENDING = '00018009'X
PARAMETER RMS$_OK_DUP = '00018011'X
PARAMETER RMS$_OK_IDX = '00018019'X
PARAMETER RMS$_OK_RLK = '00018021'X
PARAMETER RMS$_TEMP10 = '00018029'X
PARAMETER RMS$_KFF = '00018031'X
PARAMETER RMS$_OK_ALK = '00018039'X
PARAMETER RMS$_OK_DEL = '00018041'X
PARAMETER RMS$_OK_RNF = '00018049'X
PARAMETER RMS$_OK_LIM = '00018051'X
PARAMETER RMS$_OK_NOP = '00018059'X
PARAMETER RMS$_BOF = '00018198'X
PARAMETER RMS$_RNL = '000181A0'X
PARAMETER RMS$_RTB = '000181A8'X
PARAMETER RMS$_TMO = '000181B0'X
PARAMETER RMS$_TNS = '000181B8'X
PARAMETER RMS$_BES = '000181C0'X
PARAMETER RMS$_PES = '000181C8'X
PARAMETER RMS$_ACT = '0001825A'X
PARAMETER RMS$_DEL = '00018262'X
PARAMETER RMS$_TEMP1 = '0001826A'X
PARAMETER RMS$_DNR = '00018272'X
PARAMETER RMS$_EOF = '0001827A'X
PARAMETER RMS$_FEX = '00018282'X
PARAMETER RMS$_FLK = '0001828A'X
PARAMETER RMS$_FNF = '00018292'X
PARAMETER RMS$_PRV = '0001829A'X
PARAMETER RMS$_REX = '000182A2'X
PARAMETER RMS$_RLK = '000182AA'X
PARAMETER RMS$_RNF = '000182B2'X
PARAMETER RMS$_WLK = '000182BA'X
PARAMETER RMS$_EXP = '000182C2'X
PARAMETER RMS$_NMF = '000182CA'X
PARAMETER RMS$_SUP = '000182D2'X
PARAMETER RMS$_RSA = '000182DA'X
PARAMETER RMS$_CRC = '000182E2'X
PARAMETER RMS$_WCC = '000182EA'X
PARAMETER RMS$_IDR = '000182F2'X
PARAMETER RMS$_ABO = '000183EC'X
PARAMETER RMS$_AID = '000183F4'X
PARAMETER RMS$_ALN = '000183FC'X
PARAMETER RMS$_ALQ = '00018404'X
PARAMETER RMS$_ANI = '0001840C'X
PARAMETER RMS$_AOP = '00018414'X
PARAMETER RMS$_BKS = '0001841C'X
PARAMETER RMS$_BKZ = '00018424'X
PARAMETER RMS$_BLN = '0001842C'X
PARAMETER RMS$_BUG = '00018434'X
PARAMETER RMS$_BUG_DDI = '0001843C'X
PARAMETER RMS$_BUG_DAP = '00018444'X
PARAMETER RMS$_BUG_XX2 = '0001844C'X
PARAMETER RMS$_BUG_XX3 = '00018454'X
PARAMETER RMS$_BUG_XX4 = '0001845C'X
PARAMETER RMS$_BUG_XX5 = '00018464'X
PARAMETER RMS$_BUG_XX6 = '0001846C'X
PARAMETER RMS$_BUG_XX7 = '00018474'X
PARAMETER RMS$_BUG_XX8 = '0001847C'X
PARAMETER RMS$_BUG_XX9 = '00018484'X
PARAMETER RMS$_CAA = '0001848C'X
PARAMETER RMS$_CCR = '00018494'X
PARAMETER RMS$_CHG = '0001849C'X
PARAMETER RMS$_CHK = '000184A4'X
PARAMETER RMS$_COD = '000184AC'X
PARAMETER RMS$_CUR = '000184B4'X
PARAMETER RMS$_DAN = '000184BC'X
PARAMETER RMS$_DEV = '000184C4'X
PARAMETER RMS$_DIR = '000184CC'X
PARAMETER RMS$_DME = '000184D4'X
PARAMETER RMS$_DNA = '000184DC'X
PARAMETER RMS$_DTP = '000184E4'X
PARAMETER RMS$_DUP = '000184EC'X
PARAMETER RMS$_DVI = '000184F4'X
PARAMETER RMS$_ESA = '000184FC'X
PARAMETER RMS$_ESS = '00018504'X
PARAMETER RMS$_FAB = '0001850C'X
PARAMETER RMS$_FAC = '00018514'X
PARAMETER RMS$_FLG = '0001851C'X
PARAMETER RMS$_FNA = '00018524'X
PARAMETER RMS$_FNM = '0001852C'X
PARAMETER RMS$_FSZ = '00018534'X
PARAMETER RMS$_FOP = '0001853C'X
PARAMETER RMS$_FUL = '00018544'X
PARAMETER RMS$_IAL = '0001854C'X
PARAMETER RMS$_IAN = '00018554'X
PARAMETER RMS$_IDX = '0001855C'X
PARAMETER RMS$_IFI = '00018564'X
PARAMETER RMS$_IMX = '0001856C'X
PARAMETER RMS$_IOP = '00018574'X
PARAMETER RMS$_IRC = '0001857C'X
PARAMETER RMS$_ISI = '00018584'X
PARAMETER RMS$_KBF = '0001858C'X
PARAMETER RMS$_KEY = '00018594'X
PARAMETER RMS$_KRF = '0001859C'X
PARAMETER RMS$_KSZ = '000185A4'X
PARAMETER RMS$_LAN = '000185AC'X
PARAMETER RMS$_LBL = '000185B4'X
PARAMETER RMS$_LNE = '000185BC'X
PARAMETER RMS$_LOC = '000185C4'X
PARAMETER RMS$_MRN = '000185CC'X
PARAMETER RMS$_MRS = '000185D4'X
PARAMETER RMS$_NAM = '000185DC'X
PARAMETER RMS$_NEF = '000185E4'X
PARAMETER RMS$_NID = '000185EC'X
PARAMETER RMS$_NOD = '000185F4'X
PARAMETER RMS$_NPK = '000185FC'X
PARAMETER RMS$_ORD = '00018604'X
PARAMETER RMS$_ORG = '0001860C'X
PARAMETER RMS$_PBF = '00018614'X
PARAMETER RMS$_PLG = '0001861C'X
PARAMETER RMS$_POS = '00018624'X
PARAMETER RMS$_PRM = '0001862C'X
PARAMETER RMS$_QUO = '00018634'X
PARAMETER RMS$_RAB = '0001863C'X
PARAMETER RMS$_RAC = '00018644'X
PARAMETER RMS$_RAT = '0001864C'X
PARAMETER RMS$_RBF = '00018654'X
PARAMETER RMS$_RFA = '0001865C'X
PARAMETER RMS$_RFM = '00018664'X
PARAMETER RMS$_RHB = '0001866C'X
PARAMETER RMS$_RLF = '00018674'X
PARAMETER RMS$_ROP = '0001867C'X
PARAMETER RMS$_RRV = '00018684'X
PARAMETER RMS$_RVU = '0001868C'X
PARAMETER RMS$_RSS = '00018694'X
PARAMETER RMS$_RST = '0001869C'X
PARAMETER RMS$_RSZ = '000186A4'X
PARAMETER RMS$_SEQ = '000186AC'X
PARAMETER RMS$_SHR = '000186B4'X
PARAMETER RMS$_SIZ = '000186BC'X
PARAMETER RMS$_SQO = '000186C4'X
PARAMETER RMS$_STK = '000186CC'X
PARAMETER RMS$_SYN = '000186D4'X
PARAMETER RMS$_TRE = '000186DC'X
PARAMETER RMS$_TYP = '000186E4'X
PARAMETER RMS$_UBF = '000186EC'X
PARAMETER RMS$_USZ = '000186F4'X
PARAMETER RMS$_VER = '000186FC'X
PARAMETER RMS$_VOL = '00018704'X
PARAMETER RMS$_XAB = '0001870C'X
PARAMETER RMS$_ESL = '00018714'X
PARAMETER RMS$_WSF = '0001871C'X
PARAMETER RMS$_ENV = '00018724'X
PARAMETER RMS$_PLV = '0001872C'X
PARAMETER RMS$_MBC = '00018734'X
PARAMETER RMS$_RSL = '0001873C'X
PARAMETER RMS$_WLD = '00018744'X
PARAMETER RMS$_NET = '0001874C'X
PARAMETER RMS$_IBF = '00018754'X
PARAMETER RMS$_REF = '0001875C'X
PARAMETER RMS$_IFL = '00018764'X
PARAMETER RMS$_DFL = '0001876C'X
PARAMETER RMS$_KNM = '00018774'X
PARAMETER RMS$_IBK = '0001877C'X
PARAMETER RMS$_KSI = '00018784'X
PARAMETER RMS$_LEX = '0001878C'X
PARAMETER RMS$_SEG = '00018794'X
PARAMETER RMS$_SNE = '0001879C'X
PARAMETER RMS$_SPE = '000187A4'X
PARAMETER RMS$_UPI = '000187AC'X
PARAMETER RMS$_ACS = '000187B4'X
PARAMETER RMS$_STR = '000187BC'X
PARAMETER RMS$_FTM = '000187C4'X
PARAMETER RMS$_ACC = '0001C002'X
PARAMETER RMS$_CRE = '0001C00A'X
PARAMETER RMS$_DAC = '0001C012'X
PARAMETER RMS$_ENT = '0001C01A'X
PARAMETER RMS$_EXT = '0001C022'X
PARAMETER RMS$_FND = '0001C02A'X
PARAMETER RMS$_MKD = '0001C032'X
PARAMETER RMS$_DPE = '0001C03A'X
PARAMETER RMS$_SPL = '0001C042'X
PARAMETER RMS$_DNF = '0001C04A'X
PARAMETER RMS$_ATR = '0001C0CC'X
PARAMETER RMS$_ATW = '0001C0D4'X
PARAMETER RMS$_CCF = '0001C0DC'X
PARAMETER RMS$_CDA = '0001C0E4'X
PARAMETER RMS$_CHN = '0001C0EC'X
PARAMETER RMS$_RER = '0001C0F4'X
PARAMETER RMS$_RMV = '0001C0FC'X
PARAMETER RMS$_RPL = '0001C104'X
PARAMETER RMS$_SYS = '0001C10C'X
PARAMETER RMS$_WER = '0001C114'X
PARAMETER RMS$_WPL = '0001C11C'X
PARAMETER RMS$_IFA = '0001C124'X
PARAMETER RMS$_WBE = '0001C12C'X

40
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/seek.plm Normal file
View File

@@ -0,0 +1,40 @@
$TITLE ('DQ$SEEK to XQ_SEEK Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_SEEK: do;
XQ_SEEK: procedure (conn$p,mode$p,high$offset$p,low$offset$p,excep$p)
external;
declare (conn$p,mode$p,high$offset$p,low$offset$p,excep$p) pointer;
end;
DQ$SEEK: procedure (conn,mode,high$offset,low$offset,excep$p) public;
declare conn word, mode byte, (low$offset,high$offset) word,
excep$p pointer;
call XQ_SEEK(@conn,@mode,@high$offset,@low$offset,excep$p);
end;
end DQ_SEEK;

51
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/sets.mar Normal file
View File

@@ -0,0 +1,51 @@
.TITLE SETS. PLM RUNTIME LIBRARY: SETB/SETW
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; CALL SETB(NEWVALUE,DESTINATION,COUNT)
;
NEWVALUE=4 ; BYTE (SETB) OR WORD (SETW).
DESTINATION=8 ; POINTER.
COUNT=12 ; WORD.
.ENTRY SETB.,^M<R2,R3,R4,R5>
MOVC5 #0,(R0),NEWVALUE(AP),COUNT(AP),@DESTINATION(AP)
RET
;
; CALL SETW(NEWVALUE,DESTINATION,COUNT)
;
.ENTRY SETW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 2$
MOVL DESTINATION(AP),R1
MOVW NEWVALUE(AP),R3
1$: MOVW R3,(R1)+
SOBGTR R0,1$
2$: RET
.END

88
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/shifts.mar Normal file
View File

@@ -0,0 +1,88 @@
.TITLE SHIFTS. PLM RUNTIME LIBRARY: ROL, ET AL.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; B = ROL(PATTERN,COUNT)
;
PATTERN=4 ; BYTE OR WORD.
COUNT=8 ; BYTE
.ENTRY ROL.,^M<>
MOVZBL PATTERN(AP),R0
MULL2 #^X01010101,R0 ; REPLICATE BYTE 4 TIMES.
ROTL COUNT(AP),R0,R0
RET
;
; B = ROR(PATTERN,COUNT)
;
.ENTRY ROR.,^M<>
MOVZBL PATTERN(AP),R0
MULL2 #^X01010101,R0 ; REPLICATE BYTE 4 TIMES.
MNEGB COUNT(AP),R1
ROTL R1,R0,R0
RET
;
; W = SHL(PATTERN,COUNT)
;
.ENTRY SHL.,^M<>
MOVZWL PATTERN(AP),R0
ASHL COUNT(AP),R0,R0
RET
;
; W = SHR(PATTERN,COUNT)
;
.ENTRY SHR.,^M<>
MOVZWL PATTERN(AP),R0
MNEGB COUNT(AP),R1
ASHL R1,R0,R0
RET
;
; I = SAL(PATTERN,COUNT)
;
.ENTRY SAL.,^M<>
CVTWL PATTERN(AP),R0
ASHL COUNT(AP),R0,R0
RET
;
; I = SAR(PATTERN,COUNT)
;
.ENTRY SAR.,^M<>
CVTWL PATTERN(AP),R0
MNEGB COUNT(AP),R1
ASHL R1,R0,R0
RET
.END

98
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/skips.mar Normal file
View File

@@ -0,0 +1,98 @@
.TITLE SKIPS. PLM RUNTIME LIBRARY: SKIPB, ET AL.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; W = SKIPB(SOURCE,TARGET,COUNT)
;
SOURCE=4 ; POINTER.
TARGET=8 ; BYTE OR WORD.
COUNT=12 ; WORD.
SKIPB.L::
SKIPB.S::
.ENTRY SKIPB.,^M<>
SKPC TARGET(AP),COUNT(AP),@SOURCE(AP)
BNEQ 1$
DECW R0 ; ENTIRE STRING SKIPPED: RETURN 0FFFFH.
RET
1$: SUBW3 R0,COUNT(AP),R0 ; NON-MATCH FOUND: RETURN STRING INDEX.
RET
;
; W = SKIPRB(SOURCE,TARGET,COUNT)
;
SKIPRB.L::
SKIPRB.S::
.ENTRY SKIPRB.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; ENTIRE STRING SKIPPED IF LENGTH=0.
ADDL3 R0,SOURCE(AP),R1
MOVB TARGET(AP),R3
2$: CMPB R3,-(R1)
BNEQ 3$
SOBGTR R0,2$
3$: DECW R0 ; RETURN INDEX OF LAST NON-MATCH.
RET ; (0FFFFH IF ALL MATCHED.)
;
; W = SKIPW(SOURCE,TARGET,COUNT)
;
SKIPW.L::
SKIPW.S::
.ENTRY SKIPW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; ENTIRE STRING SKIPPED IF LENGTH=0.
MOVL SOURCE(AP),R1
MOVW TARGET(AP),R3
2$: CMPW R3,(R1)+
BNEQ 4$
SOBGTR R0,2$
3$: DECW R0 ; ENTIRE STRING SKIPPED: RETURN 0FFFFH.
RET
4$: SUBW3 R0,COUNT(AP),R0 ; NON-MATCH FOUND: RETURN STRING INDEX.
RET
;
; W = SKIPRW(SOURCE,TARGET,COUNT)
;
SKIPRW.L::
SKIPRW.S::
.ENTRY SKIPRW.,^M<R3>
MOVZWL COUNT(AP),R0
BEQL 3$ ; ENTIRE STRING SKIPPED IF LENGTH=0.
ADDL3 R0,SOURCE(AP),R1
ADDL2 R0,R1
MOVW TARGET(AP),R3
2$: CMPW R3,-(R1)
BNEQ 3$
SOBGTR R0,2$
3$: DECW R0 ; RETURN INDEX OF LAST NON-MATCH.
RET ; (0FFFFH IF ALL MATCHED.)
.END

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/special.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$SPECIAL to XQ_SPECIAL Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_SPECIAL: do;
XQ_SPECIAL: procedure (type$p,conn$p,excep$p) external;
declare (type$p,conn$p,excep$p) pointer;
end;
DQ$SPECIAL: procedure (type,parameter$p,excep$p) public;
declare type byte, (parameter$p,excep$p) pointer;
call XQ_SPECIAL(@type,parameter$p,excep$p);
end;
end DQ_SPECIAL;

47
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/systemid.plm Normal file
View File

@@ -0,0 +1,47 @@
$TITLE ('UDI GET SYSTEM ID')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_SYSTEM$ID: do;
$INCLUDE (PLM$UDI:EXCEPT.LIT)
declare PTR literally 'POINTER';
declare system_id (*) byte data ('VAX/VMS');
DQ$GET$SYSTEM$ID: procedure (id$p, excep$p) public;
declare (id$p,excep$p) PTR;
declare (id based id$p) (1) byte;
declare (status based excep$p) word;
id(0)=size(system_id);
call MOVE (size(system_id), @system_id, @id(1));
status=E$OK;
end DQ$GET$SYSTEM$ID;
end DQ_SYSTEM$ID;

38
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/truncate.plm Normal file
View File

@@ -0,0 +1,38 @@
$TITLE ('DQ$TRUNCATE to XQ_TRUNCATE Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_TRUNCATE: do;
XQ_TRUNCATE: procedure (conn$p,excep$p) external;
declare (conn$p,excep$p) pointer;
end;
DQ$TRUNCATE: procedure (conn,excep$p) public;
declare conn word, excep$p pointer;
call XQ_TRUNCATE(@conn,excep$p);
end;
end DQ_TRUNCATE;

154
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/udi.def Normal file
View File

@@ -0,0 +1,154 @@
/* External declarations for UDI service routines. */
$SAVE NOLIST
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*-----------------------------------------------------------------------*/
/* */
/* R E V I S I O N H I S T O R Y */
/* */
/* 10JAN82 Alex Hunter 1. Added declaration for DQ$SET$DELIMITERS. */
/* */
/*************************************************************************/
DECLARE CONNECTION literally 'WORD';
DQ$ALLOCATE: PROCEDURE (size,excep$p) WORD EXTERNAL;
DECLARE size WORD, excep$p POINTER;
END;
DQ$ATTACH: PROCEDURE (path$p,excep$p) CONNECTION EXTERNAL;
DECLARE (path$p,excep$p) POINTER;
END;
DQ$CHANGE$EXTENSION: PROCEDURE (path$p,extension$p,excep$p) EXTERNAL;
DECLARE (path$p,extension$p,excep$p) POINTER;
END;
DQ$CLOSE: PROCEDURE (conn,excep$p) EXTERNAL;
DECLARE conn CONNECTION, excep$p POINTER;
END;
DQ$CREATE: PROCEDURE (path$p,excep$p) CONNECTION EXTERNAL;
DECLARE (path$p,excep$p) POINTER;
END;
DQ$DECODE$EXCEPTION: PROCEDURE (exception$code,message$p,excep$p)
EXTERNAL;
DECLARE exception$code WORD,
(message$p,excep$p) POINTER;
END;
DQ$DELETE: PROCEDURE (path$p,excep$p) EXTERNAL;
DECLARE (path$p,excep$p) POINTER;
END;
DQ$DETACH: PROCEDURE (conn,excep$p) EXTERNAL;
DECLARE conn CONNECTION, excep$p POINTER;
END;
DQ$EXIT: PROCEDURE (completion$code) EXTERNAL;
DECLARE completion$code WORD;
END;
DQ$FREE: PROCEDURE (segment,excep$p) EXTERNAL;
DECLARE segment WORD, excep$p POINTER;
END;
DQ$GET$ARGUMENT: PROCEDURE (argument$p,excep$p) BYTE EXTERNAL;
DECLARE (argument$p,excep$p) POINTER;
END;
DQ$GET$CONNECTION$STATUS: PROCEDURE (conn,info$p,excep$p) EXTERNAL;
DECLARE conn CONNECTION, (info$p,excep$p) POINTER;
END;
DQ$GET$EXCEPTION$HANDLER: PROCEDURE (handler$p,excep$p) EXTERNAL;
DECLARE (handler$p,excep$p) POINTER;
END;
DQ$GET$SIZE: PROCEDURE (segbase,excep$p) WORD EXTERNAL;
DECLARE segbase WORD, excep$p POINTER;
END;
DQ$GET$SYSTEM$ID: PROCEDURE (id$p,excep$p) EXTERNAL;
DECLARE (id$p,excep$p) POINTER;
END;
DQ$GET$TIME: PROCEDURE (dt$p,excep$p) EXTERNAL;
DECLARE (dt$p,excep$p) POINTER;
END;
DQ$OPEN: PROCEDURE (conn,access,num$buf,excep$p) EXTERNAL;
DECLARE conn CONNECTION, access BYTE, num$buf BYTE,
excep$p POINTER;
END;
DQ$OVERLAY: PROCEDURE (name$p,excep$p) EXTERNAL;
DECLARE (name$p,excep$p) POINTER;
END;
DQ$READ: PROCEDURE (conn,buf$p,count,excep$p) WORD EXTERNAL;
DECLARE conn CONNECTION, buf$p POINTER, count WORD,
excep$p POINTER;
END;
DQ$RENAME: PROCEDURE (old$p,new$p,excep$p) EXTERNAL;
DECLARE (old$p,new$p,excep$p) POINTER;
END;
DQ$SEEK: PROCEDURE (conn,mode,high$offset,low$offset,excep$p) EXTERNAL;
DECLARE conn CONNECTION, mode BYTE, low$offset WORD,
high$offset WORD, excep$p POINTER;
END;
DQ$SET$DELIMITERS: PROCEDURE (delimiter$set$p,excep$p) EXTERNAL;
DECLARE (delimiter$set$p,excep$p) POINTER;
END;
DQ$SPECIAL: PROCEDURE (type,parameter$p,excep$p) EXTERNAL;
DECLARE type BYTE, parameter$p POINTER, excep$p POINTER;
END;
DQ$SWITCH$BUFFER: PROCEDURE (buffer$p,excep$p) WORD EXTERNAL;
DECLARE (buffer$p,excep$p) POINTER;
END;
DQ$TRAP$CC: PROCEDURE (handler$p,excep$p) EXTERNAL;
DECLARE (handler$p,excep$p) POINTER;
END;
DQ$TRAP$EXCEPTION: PROCEDURE (handler$p,excep$p) EXTERNAL;
DECLARE (handler$p,excep$p) POINTER;
END;
DQ$TRUNCATE: PROCEDURE (conn,excep$p) EXTERNAL;
DECLARE conn CONNECTION, excep$p POINTER;
END;
DQ$WRITE: PROCEDURE (conn,buf$p,count,excep$p) EXTERNAL;
DECLARE conn CONNECTION, buf$p POINTER,
count WORD, excep$p POINTER;
END;
$RESTORE

39
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/udimsgs.msg Normal file
View File

@@ -0,0 +1,39 @@
.TITLE UDIMSGS Error and Warning Messages
!-----------------------------------------------------------------------
!
! D I S C L A I M E R N O T I C E
! ------------------- -----------
!
! This document and/or portions of the material and data furnished
! herewith, was developed under sponsorship of the U. S. Government.
! Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
! University, nor their employees, nor their respective contractors,
! subcontractors, or their employees, makes any warranty, express or
! implied, or assumes any liability or responsibility for accuracy,
! completeness or usefulness of any information, apparatus, product
! or process disclosed, or represents that its use will not infringe
! privately-owned rights. Mention of any product, its manufacturer,
! or suppliers shall not, nor is it intended to, imply approval, dis-
! approval, or fitness for any particular use. The U. S. and the
! University at all times retain the right to use and disseminate same
! for any purpose whatsoever. Such distribution shall be made by the
! National Energy Software Center at the Argonne National Laboratory
! and only subject to the distributee furnishing satisfactory proof
! that he has a valid license from the Intel Corporation in effect.
!
!-----------------------------------------------------------------------
.FACILITY UDI,132
OK <Successful completion>/SUCCESS
WARNINGS <Warnings were issued>/WARNING
ERRORS <Errors were detected>/ERROR
FATAL <Fatal errors detected>/FATAL
ABORT <Execution aborted>/SEVERE
.BASE 101
BADINDSYN <Bad syntax for indirect command line file>/SEVERE
INDNOTLAS <Indirect command line file spec must be last>/SEVERE
BADINDFIL <Unable to read indirect command line file>/SEVERE
INDTOOBIG <Indirect command file is too long>/SEVERE
.END

42
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/write.plm Normal file
View File

@@ -0,0 +1,42 @@
$TITLE ('DQ$WRITE to XQ_WRITE Interface Routine.')
$LARGE
/*************************************************************************/
/* */
/* D I S C L A I M E R N O T I C E */
/* ------------------- ----------- */
/* */
/* This document and/or portions of the material and data furnished */
/* herewith, was developed under sponsorship of the U. S. Government. */
/* Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior */
/* University, nor their employees, nor their respective contractors, */
/* subcontractors, or their employees, makes any warranty, express or */
/* implied, or assumes any liability or responsibility for accuracy, */
/* completeness or usefulness of any information, apparatus, product */
/* or process disclosed, or represents that its use will not infringe */
/* privately-owned rights. Mention of any product, its manufacturer, */
/* or suppliers shall not, nor is it intended to, imply approval, dis- */
/* approval, or fitness for any particular use. The U. S. and the */
/* University at all times retain the right to use and disseminate same */
/* for any purpose whatsoever. Such distribution shall be made by the */
/* National Energy Software Center at the Argonne National Laboratory */
/* and only subject to the distributee furnishing satisfactory proof */
/* that he has a valid license from the Intel Corporation in effect. */
/* */
/*************************************************************************/
DQ_WRITE: do;
$INCLUDE (PLM$UDI:DESCRIPT.LIT)
XQ_WRITE: procedure (conn$p,buf$d$p,excep$p) external;
declare (conn$p,buf$d$p,excep$p) pointer;
end;
DQ$WRITE: procedure (conn,buf$p,count,excep$p) public;
declare conn word, buf$p pointer, count word, excep$p pointer;
declare buf$d descriptor initial(0,DSC$K_DTYPE_T,DSC$K_CLASS_S);
buf$d.length=count; buf$d.ptr=buf$p;
call XQ_WRITE(@conn,@buf$d,excep$p);
end;
end DQ_WRITE;

42
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/xlat.mar Normal file
View File

@@ -0,0 +1,42 @@
.TITLE XLAT. PLM RUNTIME LIBRARY: XLAT.
;-----------------------------------------------------------------------
;
; D I S C L A I M E R N O T I C E
; ------------------- -----------
;
; This document and/or portions of the material and data furnished
; herewith, was developed under sponsorship of the U. S. Government.
; Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
; University, nor their employees, nor their respective contractors,
; subcontractors, or their employees, makes any warranty, express or
; implied, or assumes any liability or responsibility for accuracy,
; completeness or usefulness of any information, apparatus, product
; or process disclosed, or represents that its use will not infringe
; privately-owned rights. Mention of any product, its manufacturer,
; or suppliers shall not, nor is it intended to, imply approval, dis-
; approval, or fitness for any particular use. The U. S. and the
; University at all times retain the right to use and disseminate same
; for any purpose whatsoever. Such distribution shall be made by the
; National Energy Software Center at the Argonne National Laboratory
; and only subject to the distributee furnishing satisfactory proof
; that he has a valid license from the Intel Corporation in effect.
;
;-----------------------------------------------------------------------
.PSECT PLMRUN_CODE,RD,NOWRT,EXE,GBL,CON,LONG
;
; CALL XLAT(SOURCE,DESTINATION,COUNT,TABLE)
;
SOURCE=4 ; POINTER.
DESTINATION=8 ; POINTER.
COUNT=12 ; WORD (UNSIGNED).
TABLE=16 ; POINTER.
XLAT.S::
XLAT.L::
.ENTRY XLAT.,^M<R2,R3,R4,R5>
MOVTC COUNT(AP),@SOURCE(AP),#0,@TABLE(AP),COUNT(AP),-
@DESTINATION(AP)
RET
.END

102
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/xqcommon.for Normal file
View File

@@ -0,0 +1,102 @@
C***********************************************************************
C
C XQCOMMON.FOR
C
C
C D I S C L A I M E R N O T I C E
C ------------------- -----------
C
C This document and/or portions of the material and data furnished
C herewith, was developed under sponsorship of the U. S. Government.
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
C University, nor their employees, nor their respective contractors,
C subcontractors, or their employees, makes any warranty, express or
C implied, or assumes any liability or responsibility for accuracy,
C completeness or usefulness of any information, apparatus, product
C or process disclosed, or represents that its use will not infringe
C privately-owned rights. Mention of any product, its manufacturer,
C or suppliers shall not, nor is it intended to, imply approval, dis-
C approval, or fitness for any particular use. The U. S. and the
C University at all times retain the right to use and disseminate same
C for any purpose whatsoever. Such distribution shall be made by the
C National Energy Software Center at the Argonne National Laboratory
C and only subject to the distributee furnishing satisfactory proof
C that he has a valid license from the Intel Corporation in effect.
C
C-----------------------------------------------------------------------
C
C This include-file contains global definitions for XQIO.FOR,
C which consists of UDI-to-VMS I/O interface routines for the
C PL/M-VAX runtime library.
C
C-----------------------------------------------------------------------
C
C R E V I S I O N H I S T O R Y
C
C 14OCT81 Alex Hunter 1. Added disclaimer notice.
C 12JAN82 Alex Hunter 1. Allocate core dynamically.
C 03FEB82 Alex Hunter 1. Change name of common blocks.
C
C***********************************************************************
IMPLICIT INTEGER*2 (A-Z)
PARAMETER CONN_MIN=20,CONN_MAX=31 ! 12 connections max.
PARAMETER CHUNK_SIZE=8192 ! Core file basic allocation
! unit in bytes (should be a
! multiple of 512).
PARAMETER MAX_CHUNKS=1000 ! Max chunks per core file.
PARAMETER MAX_CORE_FILE_SIZE = CHUNK_SIZE * MAX_CHUNKS
PARAMETER OUTPUT_RECL=510 ! 1 block - 2 control bytes.
PARAMETER MAX_INPUT=512 ! Max bytes expected on input.
PARAMETER CR='0D'X,LF='0A'X
CHARACTER*45 FILENAME(CONN_MIN:CONN_MAX)
CHARACTER*2 CRLF
CHARACTER*1 XCR,XLF
EQUIVALENCE (XCR,CRLF(1:1)),(XLF,CRLF(2:2))
COMMON /XQ_CHARS/ CRLF,FILENAME
DATA XCR,XLF/CR,LF/
INTEGER*4 CHUNK_ADDRESS(0:MAX_CHUNKS-1,CONN_MIN:CONN_MAX)
BYTE TEMPORARY_BUFFER(MAX_INPUT)
COMMON /XQ_CORE/ CHUNK_ADDRESS,TEMPORARY_BUFFER
PARAMETER CHUNK_ADDRESS_DIMS = MAX_CHUNKS*(CONN_MIN-CONN_MAX+1)
!!!! DATA CHUNK_ADDRESS /12000*0/
!!!! Note: by letting the linker create demand-zero pages for
!!!! the chunk address table (instead of explicitly initializing
!!!! the table to zeroes), we save almost 100 blocks in the
!!!! image file. (But make sure the DATA statement gets re-instated
!!!! if you use this code on some other system!)
BYTE STATE(CONN_MIN:CONN_MAX)
PARAMETER STATE_UNATTACHED=0,STATE_ATTACHED=1,STATE_OPEN=2
INTEGER*4 MARKER(CONN_MIN:CONN_MAX),LENGTH(CONN_MIN:CONN_MAX)
INTEGER*2 ACCESS_RIGHTS(CONN_MIN:CONN_MAX)
PARAMETER AR_DELETE=1,AR_READ=2,AR_WRITE=4,AR_UPDATE=8
INTEGER*2 SEEK_CAPABILITY(CONN_MIN:CONN_MAX)
PARAMETER SC_FORWARD=1,SC_BACKWARD=2
BYTE ACCESS_MODE(CONN_MIN:CONN_MAX)
PARAMETER AM_READ=1,AM_WRITE=2,AM_UPDATE=3
BYTE TYPE(CONN_MIN:CONN_MAX)
PARAMETER NORMAL=0,WORK_FILE=1,INTERACTIVE=2,BYTE_BUCKET=3
LOGICAL*1 MODIFIED(CONN_MIN:CONN_MAX)
BYTE SPECIAL_MODE(CONN_MIN:CONN_MAX)
PARAMETER TRANSPARENT=1,LINE_EDITED=2,TRANSPARENT_NOWAIT=3
LOGICAL*4 TT_CHANNEL_ASSIGNED
INTEGER*2 TT_CHANNEL
COMMON /XQ_COMMON/ TT_CHANNEL_ASSIGNED,
# MARKER,LENGTH,ACCESS_RIGHTS,SEEK_CAPABILITY,
# TT_CHANNEL,ACCESS_MODE,TYPE,MODIFIED,STATE,
# SPECIAL_MODE
DATA TT_CHANNEL_ASSIGNED/.FALSE./

10
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/xqio.bld Normal file
View File

@@ -0,0 +1,10 @@
$SET VERIFY
$!
$! Command file to build the XQIO package and insert the
$! object into the PLMRUN library.
$!
$@LOGNAMES
$!
$FOR/NOLIS/DEB/NOCHECK XQIO
$LIB PLMRUN XQIO
$SET NOVERIFY

945
ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmudi/xqio.for Normal file
View File

@@ -0,0 +1,945 @@
C***********************************************************************
C
C XQIO.FOR
C
C
C D I S C L A I M E R N O T I C E
C ------------------- -----------
C
C This document and/or portions of the material and data furnished
C herewith, was developed under sponsorship of the U. S. Government.
C Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
C University, nor their employees, nor their respective contractors,
C subcontractors, or their employees, makes any warranty, express or
C implied, or assumes any liability or responsibility for accuracy,
C completeness or usefulness of any information, apparatus, product
C or process disclosed, or represents that its use will not infringe
C privately-owned rights. Mention of any product, its manufacturer,
C or suppliers shall not, nor is it intended to, imply approval, dis-
C approval, or fitness for any particular use. The U. S. and the
C University at all times retain the right to use and disseminate same
C for any purpose whatsoever. Such distribution shall be made by the
C National Energy Software Center at the Argonne National Laboratory
C and only subject to the distributee furnishing satisfactory proof
C that he has a valid license from the Intel Corporation in effect.
C
C-----------------------------------------------------------------------
C
C XQIO -- UDI I/O PACKAGE FOR VAX/VMS UTILIZING THE
C "CORE FILE" CONCEPT.
C
C-----------------------------------------------------------------------
C
C H001 20MAY81 ALEX HUNTER 1. WRITTEN.
C H002 09JUN81 ALEX HUNTER 1. IMPLEMENTED DQ$SPECIAL.
C H003 10JUN81 ALEX HUNTER 1. DQ$EXIT CALLS LIB$STOP.
C H004 08JAN82 ALEX HUNTER 1. TREAT 'LIST:...' AS INTER-
C ACTIVE (NON-CORE FILE) ON
C OUTPUT.
C H005 12JAN82 Alex Hunter 1. Allocate core dynamically.
C H006 31JAN82 Alex Hunter 1. Add indirect command file completion
C codes to DQ$EXIT.
C 2. Handle EOF on :CI:.
C H007 03FEB82 Alex Hunter 1. Change routine names.
C H008 06FEB82 Alex Hunter 1. Use local copies of RMSDEF.FOR and
C IODEF.FOR include files.
C
C-----------------------------------------------------------------------
INTEGER*2 FUNCTION DQATTACH (PATH,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
BYTE PATH(*)
INTEGER*2 STATUS
INTEGER*4 N
INTEGER*4 DESCRIPTOR(2)
DATA DESCRIPTOR /1,0/
CHARACTER*45 XQ___PATH,FULLY_QUALIFIED_NAME
LOGICAL*4 FILE_EXISTS,EOF,XQ___READ,XQ___ENSURE_ALLOCATED
CHARACTER*10 CC
DQATTACH=0
DO CONN=CONN_MIN,CONN_MAX
IF (STATE(CONN).EQ.STATE_UNATTACHED) GO TO 100
ENDDO
STATUS=E$CONTEXT
RETURN
100 FILENAME(CONN)=XQ___PATH(PATH,STATUS)
IF (STATUS.NE.E$OK) RETURN
LENGTH(CONN)=0
MARKER(CONN)=0
IF (FILENAME(CONN)(1:3).EQ.'BB:') THEN
TYPE(CONN)=BYTE_BUCKET
ACCESS_RIGHTS(CONN)=AR_READ+AR_WRITE+AR_UPDATE
SEEK_CAPABILITY(CONN)=SC_FORWARD+SC_BACKWARD
ELSE
INQUIRE (FILE=FILENAME(CONN),NAME=FULLY_QUALIFIED_NAME,
# EXIST=FILE_EXISTS,CARRIAGECONTROL=CC,ERR=900)
IF (.NOT.FILE_EXISTS) THEN
STATUS=E$FNEXIST
RETURN
ENDIF
OPEN (UNIT=CONN,FILE=FILENAME(CONN),STATUS='OLD',
# ACCESS='SEQUENTIAL',READONLY,ERR=910)
IF (FILENAME(CONN)(1:3).EQ.'CI:' .OR.
# FULLY_QUALIFIED_NAME(1:3).EQ.'_TT' .OR.
# FULLY_QUALIFIED_NAME.EQ.'SYS$INPUT:' .OR.
# FULLY_QUALIFIED_NAME.EQ.'SYS$COMMAND:') THEN
TYPE(CONN)=INTERACTIVE
ACCESS_RIGHTS(CONN)=AR_READ
SEEK_CAPABILITY(CONN)=0
SPECIAL_MODE(CONN)=LINE_EDITED
ELSE
TYPE(CONN)=NORMAL
ACCESS_RIGHTS(CONN)=AR_DELETE+AR_READ+AR_WRITE+AR_UPDATE
SEEK_CAPABILITY(CONN)=SC_FORWARD+SC_BACKWARD
DO WHILE (.TRUE.)
! Ensure room for max size record + CRLF.
IF (.NOT.XQ___ENSURE_ALLOCATED(CONN,
# LENGTH(CONN)+MAX_INPUT+1))
# THEN
STATUS=E$MEM ! Can't get core.
CLOSE (UNIT=CONN)
RETURN
ENDIF
IF (LENGTH(CONN)/CHUNK_SIZE.EQ.
# (LENGTH(CONN)+MAX_INPUT-1)/CHUNK_SIZE)
# THEN
! Record is guaranteed to fit in current chunk.
DESCRIPTOR(2) =
# CHUNK_ADDRESS(LENGTH(CONN)/CHUNK_SIZE,CONN) +
# MOD(LENGTH(CONN),CHUNK_SIZE)
EOF=XQ___READ(CONN,DESCRIPTOR,N)
ELSE
! Record might cross chunk boundary, so read it
! into a temporary buffer and then copy it to the
! core file.
EOF=XQ___READ(CONN,%DESCR(TEMPORARY_BUFFER),N)
CALL XQ___MOVE_TO_FILE (CONN,TEMPORARY_BUFFER,
# LENGTH(CONN),N)
ENDIF
IF (EOF) GO TO 200
LENGTH(CONN)=LENGTH(CONN)+N
IF (CC.NE.'NONE') THEN
CALL XQ___MOVE_TO_FILE(CONN,%REF(CRLF),LENGTH(CONN),2)
LENGTH(CONN)=LENGTH(CONN)+2
ENDIF
ENDDO
200 CLOSE (UNIT=CONN)
ENDIF
ENDIF
MODIFIED(CONN)=.FALSE.
STATE(CONN)=STATE_ATTACHED
STATUS=E$OK
DQATTACH = CONN
RETURN
900 CONTINUE
910 CONTINUE
STATUS=E$FACCESS
RETURN
END
C-----------------------------------------------------------------------
LOGICAL*4 FUNCTION XQ___READ (CONN,BUFFER,N)
INCLUDE 'XQCOMMON.FOR/NOLIST'
CHARACTER*1 BUFFER
INTEGER*4 N
READ(CONN,1000,END=200) N,BUFFER(1:N)
1000 FORMAT(Q,A)
XQ___READ=.FALSE.
RETURN
200 XQ___READ=.TRUE.
N=0
RETURN
END
C-----------------------------------------------------------------------
INTEGER*2 FUNCTION DQCREATE (PATH,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
BYTE PATH(*)
INTEGER*2 STATUS
CHARACTER*45 XQ___PATH,FULLY_QUALIFIED_NAME
LOGICAL*4 FILE_EXISTS
DQCREATE = 0
DO CONN=CONN_MIN,CONN_MAX
IF (STATE(CONN).EQ.STATE_UNATTACHED) GO TO 100
ENDDO
STATUS=E$CONTEXT
RETURN
100 FILENAME(CONN)=XQ___PATH(PATH,STATUS)
IF (STATUS.NE.E$OK) RETURN
IF (FILENAME(CONN)(1:5).EQ.'WORK:') THEN
TYPE(CONN)=WORK_FILE
ACCESS_RIGHTS(CONN)=AR_READ+AR_WRITE+AR_UPDATE
SEEK_CAPABILITY(CONN)=SC_FORWARD+SC_BACKWARD
ELSEIF (FILENAME(CONN)(1:3).EQ.'BB:') THEN
TYPE(CONN)=BYTE_BUCKET
ACCESS_RIGHTS(CONN)=AR_READ+AR_WRITE+AR_UPDATE
SEEK_CAPABILITY(CONN)=SC_FORWARD+SC_BACKWARD
ELSE
INQUIRE (FILE=FILENAME(CONN),NAME=FULLY_QUALIFIED_NAME,
# EXIST=FILE_EXISTS,ERR=900)
IF (FILENAME(CONN)(1:3).EQ.'CO:' .OR.
# FILENAME(CONN)(1:5).EQ.'LIST:' .OR.
# FULLY_QUALIFIED_NAME(1:3).EQ.'_TT' .OR.
# FULLY_QUALIFIED_NAME.EQ.'SYS$OUTPUT:' .OR.
# FULLY_QUALIFIED_NAME.EQ.'SYS$ERROR:') THEN
TYPE(CONN)=INTERACTIVE
ACCESS_RIGHTS(CONN)=AR_WRITE
SEEK_CAPABILITY(CONN)=0
SPECIAL_MODE(CONN)=LINE_EDITED
OPEN (UNIT=CONN,FILE=FILENAME(CONN),STATUS='UNKNOWN',
# ERR=900)
ELSE
TYPE(CONN)=NORMAL
ACCESS_RIGHTS(CONN)=AR_DELETE+AR_READ+AR_WRITE+AR_UPDATE
SEEK_CAPABILITY(CONN)=SC_FORWARD+SC_BACKWARD
ENDIF
ENDIF
LENGTH(CONN)=0
MARKER(CONN)=0
MODIFIED(CONN)=.FALSE.
STATE(CONN)=STATE_ATTACHED
STATUS=E$OK
DQCREATE=CONN
RETURN
900 STATUS=E$FACCESS
RETURN
END
C-----------------------------------------------------------------------
CHARACTER*45 FUNCTION XQ___PATH (PATH,STATUS)
IMPLICIT INTEGER*2 (A-Z)
INCLUDE 'EXCEPT.FOR/NOLIST'
BYTE PATH(*)
INTEGER*2 STATUS
XQ___PATH=' '
N=PATH(1)
IF (N.LE.0 .OR. N.GT.45) THEN
STATUS=E$SYNTAX
RETURN
ENDIF
DO I=1,N
XQ___PATH(I:I)=CHAR(PATH(I+1))
ENDDO
IF (XQ___PATH(1:1).EQ.':') XQ___PATH=XQ___PATH(2:)
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE DQDELETE (PATH,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
BYTE PATH(*)
INTEGER*2 STATUS
CHARACTER*45 XQ___PATH,FILE
FILE=XQ___PATH(PATH,STATUS)
IF (STATUS.NE.E$OK) RETURN
OPEN (UNIT=99,FILE=FILE,STATUS='OLD',ERR=900)
CLOSE (UNIT=99,DISP='DELETE',ERR=950)
STATUS=E$OK
RETURN
900 STATUS=E$FNEXIST
RETURN
950 STATUS=E$FACCESS
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE DQRENAME (OLD,NEW,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INCLUDE 'RMSDEF.FOR/NOLIST'
BYTE OLD(*), NEW(*)
INTEGER*2 STATUS
INTEGER*4 XQ___RENAME,IRMS
CHARACTER*45 XQ___PATH,OLD_FILE,NEW_FILE
INTEGER*4 RMSCODE(10)
DATA RMSCODE
//RMS$_SUC,RMS$_DEV,RMS$_DIR,RMS$_FEX,RMS$_FNF,RMS$_FNM
,,RMS$_IDR,RMS$_PRV,RMS$_SUP,RMS$_SYN
//
INTEGER*2 UDICODE(10)
DATA UDICODE
//E$OK,E$SUPPORT,E$SYNTAX,E$FEXIST,E$FNEXIST,E$SYNTAX
,,E$CROSSFS,E$FACCESS,E$SUPPORT,E$SYNTAX
//
OLD_FILE=XQ___PATH(OLD,STATUS)
IF (STATUS.NE.E$OK) RETURN
NEW_FILE=XQ___PATH(NEW,STATUS)
IF (STATUS.NE.E$OK) RETURN
IRMS=XQ___RENAME(OLD_FILE,NEW_FILE)
DO I=1,10
IF (IRMS.EQ.RMSCODE(I)) THEN
STATUS=UDICODE(I)
RETURN
ENDIF
ENDDO
CALL LIB$SIGNAL(%VAL(IRMS))
STATUS=E$FACCESS ! For lack of anything better.
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_DETACH (CONN,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
INTEGER*4 I,N
INTEGER*4 DESCRIPTOR(2)
DATA DESCRIPTOR /1,0/
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ENDIF
IF (STATE(CONN).EQ.STATE_OPEN) CALL XQ_CLOSE(CONN,STATUS)
STATE(CONN)=STATE_UNATTACHED
IF (TYPE(CONN).EQ.NORMAL) THEN
IF (MODIFIED(CONN)) THEN
OPEN (UNIT=CONN,FILE=FILENAME(CONN),STATUS='NEW',
# FORM='FORMATTED',CARRIAGECONTROL='NONE',
# ORGANIZATION='SEQUENTIAL',RECL=OUTPUT_RECL,
# RECORDTYPE='VARIABLE',ERR=900)
DO I=0,LENGTH(CONN)-1,OUTPUT_RECL
N = MIN(LENGTH(CONN)-I,OUTPUT_RECL) ! Next record size.
IF (I/CHUNK_SIZE.EQ.(I+N-1)/CHUNK_SIZE) THEN
! Next record lies entirely within one chunk,
! so we can write it out directly.
DESCRIPTOR(2) =
# CHUNK_ADDRESS(I/CHUNK_SIZE,CONN) +
# MOD(I,CHUNK_SIZE)
CALL XQ___WRITE(CONN,DESCRIPTOR,N)
ELSE
! Next record crosses a chunk boundary, so first
! copy it to a temporary buffer before writing it out.
CALL XQ___MOVE_FROM_FILE(CONN,I,TEMPORARY_BUFFER,N)
CALL XQ___WRITE(CONN,%DESCR(TEMPORARY_BUFFER),N)
ENDIF
ENDDO
CLOSE (UNIT=CONN)
ENDIF
ELSEIF (TYPE(CONN).EQ.INTERACTIVE) THEN
CLOSE (UNIT=CONN)
ENDIF
STATUS=E$OK
RETURN
900 STATUS=E$FACCESS
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ___WRITE (CONN,BUFFER,N)
INCLUDE 'XQCOMMON.FOR/NOLIST'
CHARACTER*1 BUFFER
INTEGER*4 N
WRITE(CONN,1001) BUFFER(1:N)
1001 FORMAT(A)
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_GET CONNECTION STATUS (CONN,INFO,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
BYTE INFO(7)
INTEGER*4 FILE_PTR
BYTE FP(4)
EQUIVALENCE (FILE_PTR,FP)
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ENDIF
FILE_PTR=MARKER(CONN)
INFO(1)=STATE(CONN).EQ.STATE_OPEN
INFO(2)=ACCESS_RIGHTS(CONN)
INFO(3)=SEEK_CAPABILITY(CONN)
INFO(4)=FP(1)
INFO(5)=FP(2)
INFO(6)=FP(3)
INFO(7)=FP(4)
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_OPEN (CONN,ACCESS,NUMBUF,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
BYTE ACCESS,NUMBUF
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
ELSEIF (STATE(CONN).EQ.STATE_OPEN) THEN
STATUS=E$OPEN
RETURN
ELSEIF (ACCESS.LT.1 .OR. ACCESS.GT.3) THEN
STATUS=E$PARAM
RETURN
ENDIF
ACCESS_MODE(CONN)=ACCESS
IF (ACCESS.EQ.AM_WRITE .OR. ACCESS.EQ.AM_UPDATE) THEN
MODIFIED(CONN)=.TRUE.
ENDIF
MARKER(CONN)=0
STATE(CONN)=STATE_OPEN
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_SEEK (CONN,MODE,HIGH_OFFSET,LOW_OFFSET,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,HIGH_OFFSET,LOW_OFFSET,STATUS
BYTE MODE
INTEGER*4 OFFSET
INTEGER*2 OFF(2)
EQUIVALENCE (OFFSET,OFF)
INTEGER*4 I
LOGICAL*4 XQ___ENSURE_ALLOCATED
BYTE ZEROES(512)
DATA ZEROES /512*0/
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (STATE(CONN).NE.STATE_OPEN) THEN
STATUS=E$NOPEN
RETURN
ENDIF
IF (TYPE(CONN).EQ.BYTE_BUCKET) GO TO 999
OFF(1)=LOW_OFFSET
OFF(2)=HIGH_OFFSET
GO TO (100,200,300,400), MODE
STATUS=E$PARAM
RETURN
C
C------ MODE 1: SEEK BACKWARD.
C
100 IF ((SEEK_CAPABILITY(CONN).AND.SC_BACKWARD).EQ.0) THEN
STATUS=E$SUPPORT
RETURN
ENDIF
MARKER(CONN)=MAX(MARKER(CONN)-OFFSET,0)
GO TO 999
C
C------ MODE 2: SEEK ABSOLUTE.
C
200 IF (SEEK_CAPABILITY(CONN).NE.SC_FORWARD+SC_BACKWARD) THEN
STATUS=E$SUPPORT
RETURN
ENDIF
MARKER(CONN)=OFFSET
GO TO 950
C
C------ MODE 3: SEEK FORWARD.
C
300 IF ((SEEK_CAPABILITY(CONN).AND.SC_FORWARD).EQ.0) THEN
STATUS=E$SUPPORT
RETURN
ENDIF
MARKER(CONN)=MARKER(CONN)+OFFSET
GO TO 950
C
C------ MODE 4: SEEK BACKWARD FROM END OF FILE.
C
400 IF ((SEEK_CAPABILITY(CONN).AND.SC_BACKWARD).EQ.0) THEN
STATUS=E$SUPPORT
RETURN
ENDIF
MARKER(CONN)=MAX(LENGTH(CONN)-OFFSET,0)
GO TO 999
C
C------ TEST IF FILE NEEDS TO BE EXTENDED WITH NULLS.
C
950 IF (ACCESS_MODE(CONN).EQ.AM_READ) THEN
MARKER(CONN)=MIN(MARKER(CONN),LENGTH(CONN))
ELSEIF (MARKER(CONN).GT.LENGTH(CONN)) THEN
IF (.NOT.XQ___ENSURE_ALLOCATED(CONN,MARKER(CONN)-1)) THEN
STATUS=E$MEM ! Can't get core.
MARKER(CONN)=LENGTH(CONN)
RETURN
ENDIF
DO I=LENGTH(CONN),MARKER(CONN)-1,512
CALL XQ___MOVE_TO_FILE(CONN,ZEROES,I,
# MIN(MARKER(CONN)-I,512))
ENDDO
LENGTH(CONN)=MARKER(CONN)
ENDIF
999 STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
INTEGER*2 FUNCTION XQ_READ (CONN,BUF,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INCLUDE 'IODEF.FOR/NOLIST'
INTEGER*2 CONN,STATUS
CHARACTER*(*) BUF
INTEGER*4 N,K
INTEGER*4 NO_TERMINATORS(2), IO_FUNCTION_CODE
DATA NO_TERMINATORS/0,0/
INTEGER*2 IOSB(4)
LOGICAL*4 SS,SYS$ASSIGN
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (STATE(CONN).NE.STATE_OPEN) THEN
STATUS=E$NOPEN
RETURN
ELSEIF (ACCESS_MODE(CONN).EQ.AM_WRITE) THEN
STATUS=E$OWRITE
RETURN
ENDIF
IF (TYPE(CONN).EQ.INTERACTIVE) THEN
IF (SPECIAL_MODE(CONN).EQ.LINE_EDITED) THEN
READ(CONN,1002,END=999) N,BUF(1:MIN(N,LEN(BUF)-2))
1002 FORMAT(Q,A)
K=MIN(N+2,LEN(BUF))
BUF(K-1:K)=CRLF
ELSE ! --- TRANSPARENT.
IF (.NOT.TT_CHANNEL_ASSIGNED) THEN
SS=SYS$ASSIGN('TT',TT_CHANNEL,,)
IF (.NOT.SS) CALL LIB$SIGNAL(%VAL(SS))
TT_CHANNEL_ASSIGNED=.TRUE.
ENDIF
IO_FUNCTION_CODE=IO$_READVBLK+IO$M_NOECHO+IO$M_NOFILTR
IF (SPECIAL_MODE(CONN).EQ.TRANSPARENT_NOWAIT) THEN
IO_FUNCTION_CODE=IO_FUNCTION_CODE+IO$M_TIMED
ENDIF
CALL SYS$QIOW(,%VAL(TT_CHANNEL),%VAL(IO_FUNCTION_CODE),
# IOSB,,,%REF(BUF),%VAL(LEN(BUF)),%VAL(0),
# %REF(NO_TERMINATORS),,)
K=IOSB(2) ! # BYTES ACTUALLY READ.
ENDIF
ELSEIF (TYPE(CONN).EQ.BYTE_BUCKET) THEN
999 K=0 ! End of file.
ELSE
K=MIN(LEN(BUF),LENGTH(CONN)-MARKER(CONN))
CALL XQ___MOVE_FROM_FILE(CONN,MARKER(CONN),%REF(BUF),K)
MARKER(CONN)=MARKER(CONN)+K
ENDIF
STATUS=E$OK
XQ_READ=K
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_WRITE (CONN,BUF,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
CHARACTER*(*) BUF
INTEGER*4 I
LOGICAL*4 XQ___ENSURE_ALLOCATED
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (STATE(CONN).NE.STATE_OPEN) THEN
STATUS=E$NOPEN
RETURN
ELSEIF (ACCESS_MODE(CONN).EQ.AM_READ) THEN
STATUS=E$OREAD
RETURN
ENDIF
IF (TYPE(CONN).EQ.INTERACTIVE) THEN
DO I=1,LEN(BUF),80
WRITE(CONN,1003) BUF(I:MIN(LEN(BUF),I+79))
ENDDO
1003 FORMAT('+',A,$)
ELSEIF (TYPE(CONN).EQ.BYTE_BUCKET) THEN
! NO-OP.
ELSE
IF (.NOT.XQ___ENSURE_ALLOCATED(CONN,MARKER(CONN)+LEN(BUF)-1))
# THEN
STATUS=E$MEM ! Can't get core.
RETURN
ENDIF
CALL XQ___MOVE_TO_FILE(CONN,%REF(BUF),MARKER(CONN),LEN(BUF))
MARKER(CONN)=MARKER(CONN)+LEN(BUF)
LENGTH(CONN)=MAX(LENGTH(CONN),MARKER(CONN))
ENDIF
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_TRUNCATE (CONN,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (STATE(CONN).NE.STATE_OPEN) THEN
STATUS=E$NOPEN
RETURN
ELSEIF (ACCESS_MODE(CONN).EQ.AM_READ) THEN
STATUS=E$OREAD
RETURN
ENDIF
LENGTH(CONN)=MARKER(CONN)
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_CLOSE (CONN,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 CONN,STATUS
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (STATE(CONN).NE.STATE_OPEN) THEN
STATUS=E$NOPEN
RETURN
ENDIF
STATE(CONN)=STATE_ATTACHED
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_SPECIAL (TYP,PARAMETER,STATUS)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
BYTE TYP
INTEGER*2 PARAMETER,STATUS
INTEGER*2 CONN
GO TO (100,200,300), TYP
STATUS=E$PARAM
RETURN
100 CONTINUE
200 CONTINUE
300 CONTINUE
CONN=PARAMETER
IF (CONN.LT.CONN_MIN .OR. CONN.GT.CONN_MAX) THEN
STATUS=E$PARAM
RETURN
ELSEIF (STATE(CONN).EQ.STATE_UNATTACHED) THEN
STATUS=E$EXIST
RETURN
ELSEIF (TYPE(CONN).NE.INTERACTIVE) THEN
STATUS=E$SUPPORT
RETURN
ENDIF
SPECIAL_MODE(CONN)=TYP
STATUS=E$OK
RETURN
END
C-----------------------------------------------------------------------
SUBROUTINE XQ_EXIT (COMPLETION_CODE)
INCLUDE 'XQCOMMON.FOR/NOLIST'
INCLUDE 'EXCEPT.FOR/NOLIST'
INTEGER*2 COMPLETION_CODE
INTEGER*2 STATUS
EXTERNAL UDI_OK,UDI_WARNINGS,UDI_ERRORS,UDI_FATAL,UDI_ABORT
EXTERNAL UDI_BADINDSYN,UDI_INDNOTLAS,UDI_BADINDFIL,UDI_INDTOOBIG
DO CONN=CONN_MIN,CONN_MAX
IF (STATE(CONN).NE.STATE_UNATTACHED) THEN
CALL XQ_DETACH(CONN,STATUS)
ENDIF
ENDDO
GO TO (1,2,3,4), COMPLETION_CODE+1
GO TO (101,102,103,104), COMPLETION_CODE-100
CALL LIB$SIGNAL(UDI_ABORT)
1 CALL EXIT
2 CALL LIB$SIGNAL(UDI_WARNINGS)
CALL EXIT
3 CALL LIB$SIGNAL(UDI_ERRORS)
CALL EXIT
4 CALL LIB$SIGNAL(UDI_FATAL)
CALL EXIT
101 CALL LIB$SIGNAL(UDI_BADINDSYN)
CALL EXIT
102 CALL LIB$SIGNAL(UDI_INDNOTLAS)
CALL EXIT
103 CALL LIB$SIGNAL(UDI_BADINDFIL)
CALL EXIT
104 CALL LIB$SIGNAL(UDI_INDTOOBIG)
CALL EXIT
END
LOGICAL*4 FUNCTION XQ___ENSURE_ALLOCATED (CONN, BYTE_INDEX)
C-----------------------------------------------------------------------
C
C This function is called to ensure that enough core is allocated
C to contain bytes 0..BYTE_INDEX for connection CONN.
C
C Returns .TRUE. if enough core is allocated.
C Returns .FALSE. if core not available, or chunk table size
C would be exceeded.
C
C Assumes CONN is a valid connection number.
C Assumes BYTE_INDEX > 0.
C Assumes chunks are consecutively allocated from chunk 0 up.
C
C-----------------------------------------------------------------------
INCLUDE 'XQCOMMON.FOR/NOLIST'
INTEGER*2 CONN ! Connection token.
INTEGER*4 BYTE_INDEX ! Highest byte index necessary to be
! allocated.
INTEGER*4 CHUNK
LOGICAL*4 LIB$GET_VM
IF (BYTE_INDEX.GE.MAX_CORE_FILE_SIZE) THEN
XQ___ENSURE_ALLOCATED=.FALSE. ! Chunk table size exceeded.
RETURN
ENDIF
IF (CHUNK_ADDRESS(BYTE_INDEX/CHUNK_SIZE,CONN).NE.0) THEN
XQ___ENSURE_ALLOCATED=.TRUE. ! Already allocated.
RETURN
ENDIF
! Allocate any missing chunks, up through the highest one needed.
DO CHUNK=0,BYTE_INDEX/CHUNK_SIZE
IF (CHUNK_ADDRESS(CHUNK,CONN).EQ.0) THEN
IF (.NOT.LIB$GET_VM(CHUNK_SIZE,CHUNK_ADDRESS(CHUNK,CONN)))
# THEN
XQ___ENSURE_ALLOCATED=.FALSE. ! Can't get core.
CHUNK_ADDRESS(CHUNK,CONN)=0
RETURN
ENDIF
ENDIF
ENDDO
XQ___ENSURE_ALLOCATED=.TRUE. ! Successfully allocated core.
RETURN
END
SUBROUTINE XQ___MOVE_TO_FILE (CONN, BUFFER, BYTE_INDEX, N_BYTES)
C-----------------------------------------------------------------------
C
C This subroutine is called to copy a bufferful of bytes into
C a core file.
C
C Assumes N_BYTES < 64K.
C Assumes the necessary core in the core file has already been
C allocated.
C
C-----------------------------------------------------------------------
INCLUDE 'XQCOMMON.FOR/NOLIST'
INTEGER*2 CONN ! Connection token.
BYTE BUFFER(0:*) ! Buffer to move from.
INTEGER*4 BYTE_INDEX ! Index in core file to start copying to.
INTEGER*4 N_BYTES ! Number of bytes to move (< 64K).
INTEGER*4 I,N,K,START_INDEX
I = 0 ! Index into buffer.
N = N_BYTES ! Number of bytes left to move.
START_INDEX = BYTE_INDEX ! Core file index to start next move.
DO WHILE (N.GT.0)
K = MIN(N, CHUNK_SIZE-MOD(START_INDEX,CHUNK_SIZE))
! Max bytes we can transfer without crossing chunk boundary.
CALL PLM$MOVE (%VAL(K),
# BUFFER(I),
# %VAL(CHUNK_ADDRESS(START_INDEX/CHUNK_SIZE,CONN)+
# MOD(START_INDEX,CHUNK_SIZE)))
I = I+K
START_INDEX = START_INDEX+K
N = N-K
ENDDO
RETURN
END
SUBROUTINE XQ___MOVE_FROM_FILE (CONN, BYTE_INDEX, BUFFER, N_BYTES)
C-----------------------------------------------------------------------
C
C This subroutine is called to copy a bufferful of bytes out of a
C core file
C
C Assumes N_BYTES < 64K.
C Assumes the necessary core in the core file is already allocated.
C
C-----------------------------------------------------------------------
INCLUDE 'XQCOMMON.FOR/NOLIST'
INTEGER*2 CONN ! Connection token.
INTEGER*4 BYTE_INDEX ! Index in core file to start copying
! from.
BYTE BUFFER(0:*) ! Buffer to move to.
INTEGER*4 N_BYTES ! Number of bytes to move (< 64K).
INTEGER*4 I,N,K,START_INDEX
I = 0 ! Index into buffer.
N = N_BYTES ! Number of bytes left to move.
START_INDEX = BYTE_INDEX ! Core file index to start next move.
DO WHILE (N.GT.0)
K = MIN(N,CHUNK_SIZE-MOD(START_INDEX,CHUNK_SIZE))
! Max bytes we can transfer without crossing chunk boundary.
CALL PLM$MOVE (%VAL(K),
# %VAL(CHUNK_ADDRESS(START_INDEX/CHUNK_SIZE,CONN)+
# MOD(START_INDEX,CHUNK_SIZE)),
# BUFFER(I))
I = I+K
START_INDEX = START_INDEX+K
N = N-K
ENDDO
RETURN
END