Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-compiler/tbl.bli
There are 21 other files named tbl.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
! Author: *
MODULE TBL=
BEGIN
GLOBAL BIND TBLV = #11^24 + 0^18 + 0; ! Version Date: 25-Nov-80
%(
***** Begin Revision History *****
***** End Revision History *****
)%
%(
THE CHANNEL TABLE
)%
MACRO TABMAX=16$, TABSIZ=15$; % MAX CHANNELS AND SIZE %
STRUCTURE CHTB[I,J]=[(I+1)*(J+1)]((.CHTB+.I*(J+1)+.J)<0,36>);
EXTERNAL CHTB CHNLTAB[TABMAX,TABSIZ];
%(
C H A N N E L T A B L E M A C R O S
)%
MACRO FMODE=CHAN[0]$,
FDEV=CHAN[1]$,
FBUF=CHAN[2]$,
FBUFO=CHAN[2]<18,18>$,
FBUFI=CHAN[2]<0,18>$,
FOBUFH=CHAN[3]$,
FOPTR=CHAN[4]$,
FOCNT=CHAN[5]$,
FIBUFH=CHAN[6]$,
FIPTR=CHAN[7]$,
FICNT=CHAN[8]$,
FFILE=CHAN[9]$,
FEXT=CHAN[10]$,
FERR=CHAN[10]<0,12>$,
FBLK=CHAN[10]<0,18>$,
FPROT=CHAN[11]<27,9>$,
FDMODE=CHAN[11]<23,4>$,
FTIME=CHAN[11]<13,10>$,
FDATE=CHAN[11]<0,12>$,
FPPN=CHAN[12]$,
FPRJ=CHAN[12]<18,18>$,
FPRG=CHAN[12]<0,18>$,
FSIZ=CHAN[12]<18,18>$,
FSTATUS=CHAN[13]$,
FSWITCH=CHAN[14]$,
FNEWPR=CHAN[15]<0,10>$,
%(
STATUS WORD BITS
)%
FUSER=0,18$, % ENTIRE USER FIELD %
FYEND=0,1$, % ENDFILE ALLOWED %
FYREW=1,1$, % REWIND ALLOWED %
FYREAD=2,1$, % READING ALLOWED %
FYWRITE=3,1$, % WRITING ALLOWED %
FYUPDAT=4,1$, % UPDATING ALLOWED %
FYDUMMY=5,1$, % DUMMY CHANNEL %
FYERR=6,1$, % WRITE ERRORS NOT TRAPPED %
FPRIMARY=7,1$, % PRIMARY DEFAULT VALUE %
% SYSTEM BITS OF STATUS WORD %
FSYS=18,18$, % ENTIRE SYSTEM FIELD %
FROPEN=18,1$, % FILE OPEN FOR INPUT %
FWOPEN=19,1$, % FILE OPEN FOR OUTPUT %
FEOF=20,1$, % ENDFILE ENCOUNTERED %
FIS35=21,1$, % BIT 35 IS SET %
FSET35=22,1$, % SET BIT 35 ON NEXT WRITE %
FSEQ=24,1$, % PROCESSING SEQUENCE NO. %
FPGMK=25,1$, % PROCESSING PAGE MARK %
FFISTAR=26,1$, % FILE NAME IS "*" %
FXSTAR=27,1$, % EXTENSION NAME IS "*" %
FUOPEN=28,1$, % FILE OPEN FOR UPDATE %
FDEVAS=29,1$, % DEVICE ASSIGNED %
FIOERR=30,1$, % I/O ERROR DETECTED %
FNSET=35,1$; % CHANNEL NOT SET %
MACRO
XFYEND=1^0$, % ENDFILE ALLOWED %
XFYREW=1^1$, % REWIND ALLOWED %
XFYREAD=1^2$, % READING ALLOWED %
XFYWRITE=1^3$, % WRITING ALLOWED %
XFYUPDAT=1^4$, % UPDATE ALLOWED %
XFYDUMMY=1^5$, % DUMMY CHANNEL %
XFYERR=1^6$, % ALLOW WRITE ERROR TRAP %
XFPRIMARY=1^7$; % PRIMARY DEFAULT VALUE %
MACRO OTHER=-1$;
%(
MACROS WHICH DEFINE THE CALLS
)%
MACRO UMAX=0$, % MAXIMUM CHANNEL %
UMODE=1$, % DATA MODE %
UDEV=2$, % DEVICE IN SIXBIT %
UOBUFF=3$, % OUTPUT BUFFER HEADER POINTER %
UIBUFF=4$, % INPUT BUFFER HEADER POINTER %
UOBUFFR=5$, % ADDR OF OUTPUT BUFFER %
UOPTR=6$, % OUTPUT BUFFER BYTE POINTER %
UOCNT=7$, % OUTPUT BUFFER BYTE COUNT %
UIBUFFR=8$, % ADDR OF INPUT BUFFER %
UIPTR=9$, % INPUT BUFFER BYTE POINTER %
UICNT=10$, % INPUT BUFFER BYTE COUNT %
UFILE=11$, % FILE NAME IN SIXBIT %
UEXT=12$, % EXTENSION NAME IN SIXBIT %
UBLK=13$, % %
UERR=14$, % ERROR NUMBER %
UPROT=15$, % PROTECTION KEY %
UDMODE=16$, % CREATION DATA MODE %
UTIME=17$, % CREATION TIME %
UDATE=18$, % CREATION DATE %
UPPN=19$, % PPN %
USTAT=20$, % USER BITS OF STATUS WORD %
USSTAT=21$, % SYSTEM BITS OF STATUS WORD %
USWITCH=22$, % SWITCH WORD %
UREPROT=23$; % REPROTECTION WORD %
MACRO USIZ=24$; % FILE SIZE %
MACRO MAX=24$; % MAXIMUM CODE ALLOWED %
EXTERNAL IOZERROR,IOERR;
EXTERNAL CHNLMAX,INVALID;
GLOBAL ROUTINE GETTBL(CHNL,CODE)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF .CODE EQL UMAX THEN RETURN .CHNLMAX;
IF INVALID(.CHNL,14) THEN RETURN 0;
IF .CODE GTR MAX OR .CODE LSS 0 THEN (IOZERROR_.CODE;IOERR(40); RETURN 0);
CASE .CODE OF
SET
%UMAX:% .CHNLMAX;
%UMODE:% .FMODE;
%UDEV:% .FDEV;
%UOBUFF:% .FBUFO;
%UIBUFF:% .FBUFI;
%UOBUFFR:% .FOBUFH;
%UOPTR:% .FOPTR;
%UOCNT:% .FOCNT;
%UIBUFFR:% .FIBUFH;
%UIPTR:% .FIPTR;
%UICNT:% .FICNT;
%UFILE:% .FFILE;
%UEXT:% .FEXT<18,18>^18;
%UBLK:% .FBLK;
%UERR:% .FERR;
%UPROT:% .FPROT;
%UDMODE:% .FDMODE;
%UTIME:% .FTIME;
%UDATE:% .FDATE;
%UPPN:% .FPPN;
%USTAT:% .FSTATUS<FUSER>;
%USSTAT:% .FSTATUS<FSYS>^18;
%USWITCH:% .FSWITCH;
%UREPROT:% .FNEWPR;
%USIZ:% .FSIZ;
TES
END;
GLOBAL ROUTINE SETTBL(CHNL,CODE,DATA)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF .CODE EQL UMAX THEN (IF .DATA GTR TABMAX OR .DATA LSS 0
THEN (IOZERROR_.DATA; IOERR(43); RETURN 0) ELSE
(CHNLMAX_.DATA; RETURN 0));
IF INVALID(.CHNL,20) THEN RETURN 0;
IF .CODE GTR MAX OR .CODE LSS 0 THEN (IOZERROR_.CODE; IOERR(41); RETURN 0);
IF .CODE EQL USSTAT THEN DATA_.DATA^(-18);
(CASE .CODE OF
SET
%UMAX:% CHNLMAX;
%UMODE:% FMODE;
%UDEV:% FDEV;
%UOBUFF:% FBUFO;
%UIBUFF:% FBUFI;
%UOBUFFR:% FOBUFH;
%UOPTR:% FOPTR;
%UOCNT:% FOCNT;
%UIBUFFR:% FIBUFH;
%UIPTR:% FIPTR;
%UICNT:% FICNT;
%UFILE:% FFILE;
%UEXT:% FEXT<18,18>;
%UBLK:% FBLK;
%UERR:% FERR;
%UPROT:% FPROT;
%UDMODE:% FDMODE;
%UTIME:% FTIME;
%UDATE:% FDATE;
%UPPN:% FPPN;
%USTAT:% FSTATUS<FUSER>;
%USSTAT:% FSTATUS<FSYS>;
%USWITCH:% FSWITCH;
%UREPROT:% FNEWPR;
%USIZ:% FSIZ;
TES)
_ .DATA;
END;
END ELUDOM