Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/ftncsr/blio.bli
There are 12 other files named blio.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: */AHM
MODULE BLIO=
BEGIN
GLOBAL BIND BLIOV = #11^24 + 0^18 + 1; ! Version Date: 24-Jul-81
%(
***** Begin Revision History *****
***** Begin Version 6 *****
1 1077 AHM 8-Jun-81 -----
Put in missing JFCL after GETPPN uuo in GETPPN routine.
***** 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>);
GLOBAL CHTB CHNLTAB[TABMAX,TABSIZ];
GLOBAL CHNLMAX;
EXTERNAL IOZERROR;
%(
C H A N N E L T A B L E M A C R O S
)%
%(
STATUS WORD BITS
)%
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>$, % DEVICE BLK NO DSK=0 %
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>$,
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 %
FYSIMUL=6,1$, % SIMULTANEOUS READ/WRITE ALLOWED %
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 IS ASSIGNED THIS CHANNEL %
FIOERR=30,1$, % 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 %
XFYSIMUL=1^6$, % SIMULTANEOUS READ/WRITE ALLOWED %
XFPRIMARY=1^7$, % PRIMARY DEFAULT VALUE %
XFROPEN=1^18$, % FILE OPEN FOR INPUT %
XFWOPEN=1^19$, % FILE OPEN FOR OUTPUT %
XFEOF=1^20$, % ENDFILE ENCOUNTERED %
XFIS35=1^21$, % BIT 35 IS SET %
XFSET35=1^22$, % SET BIT 35 ON NEXT WRITE %
XFSEQ=1^24$, % PROCESSING SEQUENCE NO. %
XFPGMK=1^25$, % PROCESSING PAGE MARK %
XFFISTAR=1^26$, % FILE NAME IS "*" %
XFXSTAR=1^27$, % EXTENSION NAME IS "*" %
XFUOPEN=1^28$, % FILE IS OPEN FOR UPDATE %
XFDEVAS=1^29$, % DEVICE ASSIGNED %
XFIOERR=1^30$, % I/O ERROR DETECTED %
XFNSET=1^35$; % CHANNEL NOT SET %
%(
MACROS WHICH DEFINE THE CALLS TO SETTBL/GETTBL
)%
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 %
USIZ=24$; % FILE SIZE %
FORWARD
CLOSE, %(#30 PARAMETERS: A CHANNEL NUMBER
FUNCTION: CLOSES THE SPECIFIED CHANNEL,
RELEASES ITS DEVICE, AND RESETS THE
ASSOCIATED BITS IN THE CHNLTAB ENTRY
USES: XCT
EXTERNALS: CHNLTAB
)%
CMUDEC; %(#40 PARAMETERS: LEFT JUSTIFIED ALPHA CMU
CHARGE NO., OR 0.
LEFT JUSTIFIED ALPHA CMU
MAN NO., OR 0.
FUNCTION: CONVERTS GIVEN PARAMETERS TO
DEC PPN NUMBERS....RETURNS 0 FOR 0-VALUES.
VALUE: A DEC PPN---LEFT HALF PROJECT, RIGHT
HALF PROGRAMMER.
)%
EXTERNAL
DEFAULTS;
FORWARD
DUMCHN, %(#37 PARAMETERS: 1) A CHANNEL NUMBER
2) THE DUMMY-MODE TO SET
1 -> MARK AS DUMMY
0 -> MARK AS NOT-DUMMY
FUNCTION: MARKS THE SPECIFIED CHANNEL
AS A DUMMY CHANNEL (IF
MODE=1). DUMMY CHANNELS EAT UP
OUTPUT AND RETURN ENDFILES ON INPUT.
A CHANNEL MAY BE UNDUMMIED AT
ANY TIME, SINCE IT DOES NOT AFFECT
THE ENDFILE BITS ON READ. THE
SET35 BIT IS RESET ON DUMMY OUTPUT,
HOWEVER.
EXTERNALS: CHNLTAB
)%
ENDALL, %(#31 PARAMETERS: NONE
FUNCTION: CLOSES ALL I/O CHANNELS
USES: CLOSE
EXTERNALS: CHNLTAB
)%
ENTER, %(#43 PARAMETERS: A CHANNEL NUMBER
FUNCTION: PERFORMS AN ENTER UUO ON THE
SPECIFIED CHANNEL
VALUES: 1 => SUCCESS; 0 => FAILURE
)%
FILLIN, %( 26 FUNCTION: FILLS THE INPUT BUFFER FOR A
GIVEN CHANNEL
PARAMETERS: THE CHANNEL NUMBER
USES: XINPUT, IOERR
EXTERNALS: CHNLTAB
VALUES:
0 - END-OF-FILE OCCURED
1 - SUCCESSFUL INPUT
)%
GETCHAR, %( 5 FUNCTION: RETURNS A SINGLE ASCII CHARACTER
OBTAINED FROM THE TELETYPE.
PARAMETERS: NONE
USES: TTCALL (MONITOR UUO)
VALUES: THE CHARACTER, RIGHT JUSTIFIED
)%
GETPPN, %(#23 FUNCTION: RETURNS THE VALUE OF THE
CURRENT PROJECT-PROGRAMMER NUMBER.
USES: CALLI (MONITOR UUO)
VALUE: THE PPN PAIR AS PER DEC SPECS.
)%
GETSTAT, %(#32
)%
GETSW, %(#36 PARAMETERS: 1) A CHANNEL NUMBER
FUNCTION: RETURNS THE SWITCH WORD FOR THAT CHANNEL
EXTERNALS: CHNLTAB
)%
INVALID; %(# 4
)%
EXTERNAL
IOERR;
FORWARD
IOPACK, %( 39 )%
ISREADOK, %( 9
)%
ISWRITEOK, %( 18
)%
LOOKUP, %(#42 PARAMETERS: A CHANNEL NUMBER
FUNCTION: PERFORMS A LOOKUP UUO ON
THE SPECIFIED CHANNEL.
VALUES: 1 => SUCCESS; 0 => FAILURE
)%
OPEN, %( 17 PARAMETERS: A CHANNEL NUMBER
FUNCTION: EXECUTES AND OPEN INSTRUCTION ON THE DEVICE
ASSOCIATED WITH THAT CHANNEL
USES: XCTSKIP
EXTERNALS: CHNLTAB
VALUES 1-> SUCCESS; 0 -> FAILURE
)%
OPENIN, %( 16 PARAMETRS: A CHANNEL NUMBER
FUNCTION: OPENS A DEVICE IF PERMISSIBLE AND
PERFORMS A LOOKUP AND INBUF ON THAT CHANNEL
USES: XCTSKIP,XCT,IOERR,IOPANIC,OPEN
EXTERNALS: CHNLTAB,IOZERROR
IOERRS: (7) LOOKUP FAILED
(8) OPEN FAILED
VALUES: 1 -> SUCCESS; 0 -> FAILURE
)%
OPENOUT, %( 19
)%
OUTMSG, %(#38
)%
PADNULL; %(#25
)%
EXTERNAL
IOPANIC; %( 71 PARAMETERS: AN IOERR NUMBER
FUNCTION: USED AS A IOPANIC STOP FOR
ERROS WHICH HAVE NO RECOVERY
BUT SOMEHOW RETURNED
USES:PUTMSG,DECIMAL,TTYPUTS, CALLI ,12
)%
FORWARD
PUTCHAR, %( 28
)%
PUTMSG, %(#34 PARAMETERS: AN IOERR MESSAGE, BROKEN INTO
AS MANY 5-CHARACTER LEFT-JUSTIFIED
ASCII STRINGS AS NECESSARY. ANY
NUMBER OF SUCH PARAMETERS MAY BE
PROVIDED. ALL BUT THE LAST MUST
BE PRECISELY 5 CHARACTERS; THE
LAST MUST BE LESS THAN 5.
FUCNTION: TYPES OUT THE MESSAGE ON THE TTY
USES: TTYPUTS
)%
READ, %(#27
)%
RENAME, %(#41 PARAMETERS: 1) A CHANNEL NUMBER
2) A NEW FILE NAME, OR 0 TO
RETAIN OLD ONE
3) A NEW EXTENSION NAME, OR 0 TO
RETAIN OLD ONE
4) A NEW PROTECTION KEY OR
0 TO RETAIN OLD ONE
FUNCTION: RENAMES OR DELETES THE FILE JUST
CLOSED ON THE CHANNEL SPECIFIED
USES: RENAME UUO, UNPACK, PAC, IOERR
IOERRS: 26: UNDEFINED IOERR
34: NO UFD
35: WRITE PROTECTED
36: ACTIVE FILE
37: ALREADY EXISTING FILE
38: NO FILE SELECTED
39: NO DEVICE
VALUES: 0 => RENAME FAILURE
1 => RENAME SUCCESS
)%
RESET, %(# 3 FUNCTION: RESETS I/O CHANNELS AND SETS
UP DEFAULTS FOR CHANNEL ASSIGNEMNTS.
USES: CALLI (MONITOR UUO), RETABLE
)%
RETABLE, %( 35 PARAMETERS: NONE
FUNCTION: COMPLETELY CLEARS CHNLTAB AND
THEN SETS DEFAULT VALUES
EXTERNALS: CHNLTAB
USES: DEFAULTS
)%
SET35, %(#33 PARAMETERS: A CHANNEL NUMBER
FUNCTION: MARKS THE STATUS WORD SO THAT
THE WORD CONTAINING THE NEXT
CHARACTER TO BE PLACED BY A WRITE
WILL GET BIT 35 SET TO 1. NOTE
THAT THIS BIT IS RESET WHEN BIT 35
IS SET.
USES: CHNLTAB
)%
SETCHN, %(#10
)%
SIXBIT, %(# 7 RETURNS SIXBIT VALUE OF ITS ARGUEMENT
)%
TTYPUTS, %( 20
)%
WRITE, %(#21
%
XCT, %(#24 PARAMETERS: AN OP, A REGISTER, AND THE REST OF A 23-BIT ADDRESS
FUNCTION: CONSTRUCTS AN INSTRUCTION FROM
THE GIVEN DATA AND DOES AN
XCT AGAINST IT.
VALUE: 0
%
XCTSKIP, %(#13 PARAMETERS: AN OP, A REGISTER, AND THE REST OF A 23-BIT ADDRESS
FUNCTION: CONSTRUCTS AND INSTRUCTION FROM
THE GIVEN DATA AND DOES AN XCT
AGAINST IT.
VALUES: 1 -> SKIPPED; 0 -> DID NOT
%
XINPUT, %( 14 PARAMETERS: A CHANNEL NUMBER
FUNCTION: EXECUTES IN "INPUT" INSTRUCTION
USES: XCTSKIP
VALUES: 0-> ENDFILE; 1-> SUCCESS; 2-> IOERR
)%
XOUTPUT; %( 15 PARAMETERS: A CHANNEL NUMBER
FUNCTION: EXECUTES AND "OUTPUT" INSTRUCTION
USES: XCTSKIP
VALUES: 0 -. ENDFILE; 1 -> SUCCESS; 2-> IOERR
)%
GLOBAL ROUTINE CRLF(CHNL)=
%%
%
THIS ROUTINE OUTPUTS A CARRIAGE RETURN/LINE FEED PAIR
ON THE GIVEN CHANNEL. IT IS CHEAPER TO USE A ROUTINE
TO DO THIS AND CALL IT (USES 3 INSTRUCTIONS) THAN TO
USE A MACRO IN LINE (USES 8 INSTRUCTIONS).
%
%%
(WRITE(.CHNL,#015); WRITE(.CHNL,#012));
GLOBAL ROUTINE RESET=
%%
%
THIS ROUTINE RESETS ALL MONITOR I/O CHANNELS AND ALL
SORTS OF WONDERFUL THINGS WITH ONLY ONE
INSTRUCTION!!! HOW ABOUT THAT!!! FURTHERMORE IT CALLS
RETABLE TO CLEAR THE CHANNEL TABLE TO ZEROES. NOTE
THAT THIS ASSUMES ALL I/O ACTIVITY HAS BEEN CLEARED
UP. IF IT WASN'T, THE CALLI MADE SURE.
%
%%
BEGIN
MACHOP CALLI=#047;
CALLI (0,0,0,0);
RETABLE()
END;
GLOBAL ROUTINE INVALID(CHNL,ERR)=
%%
%
THIS ROUTINE CHECKS TO SEE IF THE CHANNEL NUMBER
GIVEN IS VALID. A VALID CHANNEL NUMBER IS EITHER ZERO
(TTY) OR IN THE RANGE 1 =< CHNL =< CHNLMAX. IF IT IS
OUTSIDE THIS RANGE THEN THE CHANNEL NUMBER IS PLUNKED
INTO IOZERROR AND THE ERROR HANDLER IS CALLED. NOTE
THAT IF CONTROL RETURNS FROM THE ERROR HANDLER "TRUE"
IS PASSED TO THE CALLER OF INVALID.
%
%%
(IF (.CHNL NEQ 0) AND (.CHNL LSS 0 OR .CHNL GTR .CHNLMAX) THEN
(IOZERROR_.CHNL; IOERR(.ERR); 1) ELSE 0);
ROUTINE GETCHAR=
%%
%
THIS ROUTINE IS CALLED IN THE CASE OF A READ FROM
CHANNEL 0. NOTE THAT THE TTCALL IS "INCHWL", OR INPUT
IN LINE MODE. THUS THIS ROUTINE WILL NOT RETURN
CONTROL UNTIL A CARRIAGE RETURN, FORM FEED, ALTMODE,
OR VERTICAL TAB HAS BEEN TYPED. SUCCESSIVE CALLS WILL
RETURN SUCESSIVE CHARACTERS UNTIL THE LINE BUFFER IS
EMPTY, AFTER WHICH THE NEXT CALL WILL WAIT UNTIL IT
IS FILLED AGAIN.
%
%%
BEGIN
MACHOP TTCALL=#051;
TTCALL(4,VREG,0,0);
.VREG
END;
GLOBAL ROUTINE GETSTS(CHNL)=
BEGIN
MACRO GETSTS=#062$;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
LOCAL T;
IF INVALID(.CHNL,18) THEN 18^18 ELSE
IF NOT .FSTATUS<FDEVAS> THEN 0 ELSE
(XCT(GETSTS,@CHNL-1,T);
.T)
END;
GLOBAL ROUTINE SIXBIT(CHAR)=
(((IF .CHAR GEQ "\" THEN .CHAR AND #137 ELSE IF .CHAR LSS " " THEN #40 ELSE .CHAR)
+#40) AND #77);
ROUTINE ISREADOK(CHNL)=
%%
%
THIS ROUTINE RETURNS TRUE IF READING IS ALLOWED ON THE GIVEN
CHANNEL, OTHERWISE IT CALLES THE I/O ERROR ROUTINE
AND RETURNS WHATEVER VALUE IT RETURNS (USUALLY THE
ERROR CODE IN THE LEFT HALFWORD)
%
%%
BEGIN
REGISTER T;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
T_.FSTATUS;
IF (.T<FUSER> AND (XFYREAD+XFYUPDAT+XFYSIMUL)) EQL 0 THEN
BEGIN
IOZERROR_.CHNL;
IOERR(2)
END
%(
E R R O R 2 : ATTEMPT TO READ FROM NOREADABLE
DEVICE.
)%
ELSE
IF .T<FWOPEN> AND NOT .T<FYSIMUL> THEN
BEGIN
IOZERROR_.CHNL;
IOERR(3)
END
%(
E R R O R 3: ATTEMPT TO READ FROM DEVICE BEING WRITTEN ON
)%
ELSE
1
END;
GLOBAL ROUTINE SETCHN (CHNL,MODE,DEV,FILE,EXT,PRJ,PRG,STATUS,SW,PROT)=
BEGIN
%(
THE FUNCTION OF THIS ROUTINE IS TO
INITIALIZE THE CHANNEL TABLE VALUES
GIVEN ASCII STRINGS FOR NAMES.
THE STRUCTURE OF THE CHANNEL TABLE IS:
0 MODE (ASCII, USUALLY)
1 DEVICE IN SIXBIT FO$MAT
2 BUFFER WORD (OUT,,IN)
3-5 OUTPUT BUFFER HEADER
6-8 INPUT BUFFER HEADER
9 FILENAME IN SIXBIT
10 EXTENSION IN SIXBIT
11 0 (SET LATER BY MONITOR)
12 PPN
13 STATUS
14 SWITCHES
15 RIGHTMOST 10 BITS: PROTECTION WORD
THE SWITCH WORD CONTAINS BITS FOR EACH OF THE SWITCHES
SET EITHER BY DEFAULT OR BY /N NOTATION. THE ASSIGNMENTS ARE:
P/S BIT SWITCH
<0,1> 35 /A
<1,1> 34 /B
<2,1> 33 /C
<3,1> 32 /D
<4,1> 31 /E
<5,1> 30 /F
<6,1> 29 /G
<7,1> 28 /H
<8,1> 27 /I
<9,1> 26 /J
<10,1> 25 /K
<11,1> 24 /L
<12,1> 23 /M
<13,1> 22 /N
<14,1> 21 /O
<15,1> 20 /P
<16,1> 19 /Q
<17,1> 18 /R
<18,1> 17 /S
<19,1> 16 /T
<20,1> 15 /U
<21,1> 14 /V
<22,1> 13 /W
<23,1> 12 /X
<24,1> 11 /Y
<25,1> 10 /Z
<26,1> 9 /0
<27,1> 8 /1
<28,1> 7 /2
<29,1> 6 /3
<30,1> 5 /4
<31,1> 4 /5
<32,1> 3 /6
<33,1> 2 /7
<34,1> 1 /8
<35,1> 0 /9
THE PARAMETERS PASSED ARE:
CHNL A CHANNEL NUMBER 1=< N =< 16
MODE A DATA MODE (E.G. 1=ASCII)
DEV A POINTER TO TWO WORDS CONTAINING A DEVICE NAME
FILE " " " " " " A FILE NAME
EXT " " " A WORD CONTAINING AN EXTENSION NAME
PRJ A PROJECT N(MBER
PRG A PROGRAMMER NUMBER
STATUS BITS 32-35 OF THE STATUS WORD
SW A 36-BIT SWITCH MASK
NOTE THE FOLLOWING ACTIONS ARE TAKEN ON ZERO VALUES:
CHNL- TTY CHANNEL (NO ACTION)
MODE- THE DEFAULT MODE IS USED
DEV- THE DEFAULT DEVICE IS USED. THIS IS TRUE IF
.DEV=0 OR ..DEV=0
FILE- THE DEFAULT FILES IS USED. THIS IS TRUE IF
.FILE=0 OR ..FILE=0
EXT - THE DEFAULT EXTENSION IS USED. AS IN FILE AND DEV.
PRJ )
PRG ) NO SPECIAL ACTION, BUT EITHER BOTH MUST BE ZERO OR
BOTH NONZERO. IF ZERO THE PPN WILL BE SET TO 0.
STATUS - USE DEFAULT STATUS
SW - NO SPECIAL ACTION. SINCE SW BITS ARE OR'ED IN, A
ZERO VALUE PRODUCES NO CHANGE
)%
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
MACRO F1ST=29,7$;
IF .CHNL EQL 0 % TTY % THEN 1 ELSE
IF .CHNL LSS 0 OR .CHNL GTR TABMAX THEN IOERR(4) ELSE
IF (.FSTATUS AND (XFUOPEN+XFROPEN+XFWOPEN)) NEQ 0 THEN IOERR(17) ELSE
! SET UP THE PPN FIELDS
IF (.PRJ EQL 0) XOR (.PRG EQL 0) THEN
IOERR(5) ELSE
%(
E R R O R 5: PROJ OR PROG SPECIFIED BUT NOT BOTH
)%
BEGIN
FPRJ_.PRJ;
FPRG_.PRG;
%(
E R R O R 4 : ATTEMPT TO USE CHANNEL > 16, OR < 1
)%
%(
SET MAXCHN TO HIGHEST CHANNEL NUMBER GIVEN SO FAR
)%
IF .CHNL GTR .CHNLMAX THEN CHNLMAX_.CHNL;
%(
E R R O R 1 7 : ATTEMPT TO SETCHN ON AN OPEN CHANNEL
)%
! SET STATUS BITS
IF .STATUS NEQ 0 THEN
FSTATUS_.STATUS;
FSTATUS<FNSET>_0; % TURN OFF INVALID BIT %
! SET MODE:
IF .MODE NEQ 0 THEN
FMODE_.MODE;
! SET DEVICE
IF .DEV NEQ 0 THEN
IF .@DEV NEQ 0 THEN FDEV_IOPACK((@DEV)<0,0>,6);
! SET OBUF POINTER
IF .STATUS<FYWRITE> OR .STATUS<FYUPDAT> THEN
FBUFO_FOBUFH;
! SET IBUF POINTER
IF .STATUS<FYREAD> OR .STATUS<FYUPDAT> THEN
FBUFI_FIBUFH;
! SET UP THE FILE NAME
IF .FILE NEQ 0 THEN
IF ..FILE NEQ 0 THEN
BEGIN
FFILE_IOPACK((@FILE)<0,0>,6);
IF ..FILE<F1ST> EQL "*" THEN FSTATUS<FFISTAR>_1;
END;
! SET UP THE EXTENSION
IF .EXT NEQ 0 THEN
IF ..EXT NEQ 0 THEN
BEGIN
FEXT_IOPACK((@EXT)<0,0>,3);
IF ..EXT<F1ST> EQL "*" THEN FSTATUS<FXSTAR>_1;
END;
! SET THE SWITCH WORD
FSWITCH_.FSWITCH OR .SW;
! SET THE PROTECTION WORD
IF .PROT NEQ 0 THEN FNEWPR_.PROT;
1
END
END;
GLOBAL ROUTINE XCTSKIP(OP,REG,ETC)=
BEGIN
%%
%
THE FUNCTION OF THIS ROUTINE IS TO EXECUTE A MONITOR
UUO WHICH DOES A SKIP-RETURN. THE VALUE OF THE
ROUTINE IS TRUE IF THE SKIP-RETURN WAS TAKEN AND
FALSE IF NOT TAKEN.
%
%%
MACHOP XCT=#256, MOVEI=#201;
MACRO OPCOD=27,9$, REGFLD=23,4$;
REGISTER T;
T_.ETC;
T<OPCOD>_.OP;
T<REGFLD>_.REG;
! WE NOW HAVE AN INSTRUCTION. SET R TRUE ASSUMING SKIP RETURN
MOVEI (VREG,1);
XCT (0,T);
MOVEI (VREG,0);
! IF NO SKIP OCCURED, R IS NOW FALSE;
.VREG
END;
ROUTINE XINPUT(CHNL)=
BEGIN
MACRO IN=#056$, STATZ=#063$;
%%
%
THIS ROUTINE EXECUTES AN "INPUT" INSTRUCTION AND
RETURNS ONE OF THREE VALUES:
0 = ENDFILE OCCURED
1 = SUCCESSFUL EXECUTION
2 = FAILURE FOR I/O ERROR OF SOME KIND
NOTE HOW SNEAKY WE ARE: BOTH 0 AND 2 ARE INTERPRETED
AS "FALSE" BY BLISS!!! SO WE CAN (AND DO) USE XINPUT
IN IF-EXPRESSIONS.
%
%%
IF XCTSKIP(IN,@CHNL-1,0) THEN
BEGIN
! IF "IN" SKIPS THEN WE HAVE AN ERROR
IF XCTSKIP(STATZ,@CHNL-1,#740000) THEN
0 ELSE 2
! IF "STATZ" SKIPS THEN WE HAVE ENDFILE, ELSE ERROR
END
ELSE
! "IN" DID NOT SKIP SO WE HAVE A NEW BLOCK
1
END;
ROUTINE XOUTPUT(CHNL)=
BEGIN
%%
%
THIS ROUTINE MISBEHAVES THE SAME AS XINPUT. GO BACK
AND READ IT THERE, I'M TIRED OF TYPING.
%
%%
MACRO OUT=#057$, STATZ=#063$;
IF XCTSKIP(OUT,@CHNL-1,0) THEN
BEGIN
! IF "OUT" SKIPS THEN WE HAVE AN ERROR
IF XCTSKIP(STATZ,@CHNL-1,#740000) THEN
0 ELSE 2
! IF "STATZ" SKIPS THEN WE HAVE PHYSICAL END OF DEVICE ELSE OTHER SCREWUPS
END
ELSE
! "OUT" DID NOT SKIP, SO WE GOT RID OF THAT BLOCK OK
1
END;
ROUTINE OPENIN(CHNL)=
BEGIN
%%
%
THIS ROUTINE OPENS A CHANNEL (VIA ROUTINE "OPEN") AND
THEN PERFORMS THE NECESSARY LOOKUP AND INBUF TO ALLOW
READ OPERATIONS.
%
%%
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
MACRO INBUF=#064$;
LOCAL T;
IF NOT (T_ISREADOK(.CHNL)) THEN RETURN .T;
IF OPEN(@CHNL) THEN
BEGIN
FSTATUS<FDEVAS>_1;
IF LOOKUP(.CHNL) THEN
BEGIN
SELECT #0, #1, #10, #13, #14 OF
NSET
.FMODE: XCT(INBUF,@CHNL-1,2);
TESN;
1
END
ELSE
%LOOKUP FAILED %
( IOZERROR_.CHNL; IOERR( SELECT .FERR OF
NSET
0: 7;
1: 27;
2: 28;
7: 29;
OTHERWISE: 30;
TESN))
%%
%
E R R O R 7 : LOOKUP FAILED
%
%%
END
ELSE
%OPEN FAILED %
(IOZERROR_.CHNL;IOERR(8))
%%
%
E R R O R 8 : OPEN FAILED
%
%%
END;
ROUTINE OPEN(CHNL)=
BEGIN
%%
%
THIS ROUTINE OPENS A CHANNEL AND RETURNS TRUE IF THE
CHANNEL OPENED OR FAILS IF IT DIDN'T
%
%%
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
MACRO OPEN=#050$;
IF .FSTATUS<FDEVAS> THEN 1 ELSE
XCTSKIP(OPEN,@CHNL-1,FMODE)
END;
ROUTINE ISWRITEOK(CHNL)=
BEGIN
%%
%
THIS ROUTINE EITHER RETURNS TRUE (IN WHICH CASE
WRITING IS PERMISSIBLE) OR CALLS THE IOERR HANDLER,
AND RETURNS ITS VALUE.
%
%%
REGISTER T;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IOZERROR_.CHNL;
T_.FSTATUS;
IF (.T<FUSER> AND (XFYWRITE+XFYUPDAT+XFYSIMUL)) EQL 0 THEN IOERR(9) ELSE
IF .T<FROPEN> THEN (IF NOT (.T<FYUPDAT> OR .T<FYSIMUL>) THEN IOERR(10) ELSE 1) ELSE
1
%%
%
E R R O R 9 : ATTEMPT TO WRITE ON NONWRITEABLE DEVICE
E R R O R 10 : ATTEMPT TO WRITE ON INPUT DEVICE
%
%%
END;
ROUTINE OPENOUT(CHNL)=
BEGIN
%%
%
THIS ROUTINE OPENS A CHANNEL FOR OUPUT BY DOING AN
OPEN UUO TO OBTAIN A DEVICE, AN ENTER TO CREATE THE
FILE, AND AN OUTBUF IF NECESSARY TO CREATE THE BUFFER
CHAIN (AND A DUMMY OUTPUT UUO TO INITIALIZE THE
BUFFERS).
%
%%
MACRO OUTBUF=#065$, OUTPUT=#067$;
LOCAL T;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF NOT (T_ISWRITEOK(.CHNL)) THEN .T ELSE
BEGIN
IF OPEN(@CHNL) THEN
BEGIN
FSTATUS<FDEVAS>_1;
IF ENTER(.CHNL) THEN
BEGIN
SELECT #0, #1, #10, #13, #14 OF
NSET
.FMODE: (XCT (OUTBUF,@CHNL-1,3);
XCT (OUTPUT,@CHNL-1,0));
TESN;
1
END
ELSE
%ENTER FAILED%
(IOZERROR_.CHNL; IOERR(SELECT .FERR OF
NSET
1: 31;
2: 32;
3: 33;
7: 6;
OTHERWISE: 11;
TESN))
%%
%
E R R O R 11 : ENTER FAILED
%
%%
END
ELSE
%OPEN FAILED%
(IOZERROR_.CHNL;IOERR(12))
%%
%
E R R O R 12 : OPEN FAILED
%
%%
END
END;
GLOBAL ROUTINE TTYPUTS(STR)=
%%
%
THIS ROUTINE OUTPUTS A STRING TO THE TTY. THE VALUE
PASSED IS A POINTER TO THE STRING.
%
%%
BEGIN
MACHOP TTCALL=#051;
TTCALL (3,STR,0,1);
END;
GLOBAL ROUTINE WRITE (CHNL,CHAR)=
%%
%
THIS ROUTINE TAKES THE CHARACTER PASSED AND WRITES IT
KN THE SPECIFIED CHANNEL. IF THE CHANNEL IS A DUMMY
CHANNEL NO OPERATION TAKES PLACE. BUFFERS ARE
AUTOMATICALLY WRITTEN OUT AS THEY ARE FILLED. THE
CHANNEL AND FILE ARE OPENED IF NECESSARY. FOR ASCII
MODE FILES, BIT 35 OF THE WORD WHICH WILL ACCEPT THE
GIVEN CHARACTER MAY BE SET TO 1 IF THE <FSET35> BIT
OF THE STATUS WORD IS 1. THIS (THE <FSET35> BIT) IS
THEN CLEARED. RETURNS TRUE IF SUCCESSFUL AND FALSE IF
NOT. THE FIOERR BIT IS SET FOR FAILURES INVOLVING
VALID CHANNELS.
%
%%
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
LOCAL T;
IF INVALID(.CHNL,23) THEN 23^18 ELSE
IF .CHNL EQL 0 THEN (PUTCHAR(.CHAR);1) ELSE
BEGIN
FSTATUS<FIOERR>_1; % ASSUME WRONG UNTIL PROVEN OTHERWISE %
%%
%
IF WE HAVE A DUMMY CHANNEL, GO BACK WITHOUT DOING ANYTHING
%
%%
IF .FSTATUS<FYDUMMY> THEN (FSTATUS_ .FSTATUS AND NOT(XFSET35+XFIOERR);
RETURN 1);
IF NOT .FSTATUS<FWOPEN> THEN
BEGIN
IF NOT (T_OPENOUT(.CHNL)) THEN RETURN .T; % IF IT WASNT OPEN, THEN OPEN IT %
FSTATUS<FWOPEN>_1;
END;
IF .FOCNT EQL 0 THEN
% BUFFER IS FULL %
BEGIN
IF NOT XOUTPUT(.CHNL) THEN (IOZERROR_.CHNL;RETURN IOERR(23));
END;
FOCNT_.FOCNT-1;
%%
%
WE HAVE JUST DECREASED THE BUFFER COUNT. NOW PUT A
CHARACTER IN
%
%%
REPLACEI (FOPTR,.CHAR);
%%
%
IF USER SETS BIT <FSET35> THEN HE WANTS BIT 35 OF THE
CURRENT WORD SET TO A 1 FOR SEQUENCE NUMBERS.
%
%%
IF .FSTATUS<FSET35>THEN
BEGIN
(@FOPTR)<0,36>_.((@FOPTR)<0,36>) OR 1;
FSTATUS<FSET35>_0;
END;
FSTATUS<FIOERR>_0; % PROVEN OTHERWISE %
1
END
END;
GLOBAL ROUTINE GETPPN=
%%
%
THIS ROUTINE RETURNS THE PROJECT PROGRAMMER NUMBER
PAIR AS DETERMINED BY THE JOB LOGGED ON. IT USES THE
CALLI UUO.
%
%%
BEGIN
%[1077]% MACHOP CALLI=#047,JFCL=#255;
CALLI (VREG,#24) ; % CALL [SIXBIT /GETPPN/]%
%[1077]% JFCL (0,0); % NOOP FOR REMOTE POSSIBILITY OF GETPPN SKIPPING %
.VREG
END;
GLOBAL ROUTINE XCT(OP,REG,ETC)=
BEGIN
MACHOP XCT=#256;
REGISTER T;
MACRO OPCOD=27,9$, REGFLD=23,4$;
T_.ETC;
T<OPCOD>_.OP;
T<REGFLD>_.REG;
XCT(0,T);
END;
GLOBAL ROUTINE PADNULL(CHNL)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
MACRO POS=30,6$;
MACRO SIZE=24,6$;
LOCAL T;
%(
THE FUNCTION OF THIS ROUTINE IS TO PADD THE CURRENT WORD
BEING FILLED TO NULLS, ALLOWING INSERTION OF SEQUENCE
NUMBERS IN THE NEXT WORD.
WE ACCOMPLISH THIS BY WRITING CHARS UNTIL THE BYTE POINTER
POSITION FIELD BECOMES LESS THAN THE SIZE FIELD, INDICATING THE NEXT REPLACEI WILL
WRITE INTO THE FIRST CHARACTER OF THE ENXT WORD.
)%
IF .FSTATUS<FWOPEN> THEN
WHILE .FOPTR<POS> GEQ .FOPTR<SIZE> DO
IF NOT (T_WRITE(.CHNL,0)) THEN RETURN .T;
1
END;
ROUTINE FILLIN(CHNL)=
BEGIN
LOCAL T;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF NOT (T_XINPUT(.CHNL)) THEN
% WE HAVE EITHER AN ERROR OR AN ENDFILE %
BEGIN
IF .T EQL 0 THEN
BEGIN
% WE HAVE AN ENDFILE %
FSTATUS<FEOF>_1;
0
END
ELSE
BEGIN
% WE HAVE OTHER PROBLEMS %
(IOZERROR_.CHNL;IOERR(13))
!
! E R R O R 1 3 : READ ERROR
!
END
END
ELSE
% WE HAVE FILLED A BUFFER %
1
END;
GLOBAL ROUTINE READ(CHNL)=
BEGIN
LOCAL T;
REGISTER TEMP;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF INVALID(.CHNL,22) THEN (FSTATUS<FIOERR>_1; 22^18) ELSE
IF .CHNL EQL 0 THEN GETCHAR() ELSE
%(
IF DUMMY CHANNEL OR EOF BIT ON THEN GIVE ENFILE
)%
BEGIN
IF (.FSTATUS AND (XFYDUMMY+XFEOF)) NEQ 0 THEN (FSTATUS<FEOF>_1; RETURN -1);
FSTATUS<FIOERR>_0; % ASSUME OK %
IF NOT .FSTATUS<FROPEN> THEN
BEGIN
IF NOT (T_OPENIN(.CHNL)) THEN RETURN .T;
FSTATUS<FROPEN>_1;
IF ((T_ FILLIN(.CHNL)) EQL 0 ) THEN RETURN -1 ELSE IF NOT .T THEN (FSTATUS<FIOERR>_1; RETURN .T);
END;
% AT THIS POINT WE PRESUMABLY HAVE SOMETHING IN THE BUFFER %
WHILE .FICNT EQL 0 DO
BEGIN
% BUFFER WAS EMPTY %
IF ((T_ FILLIN(.CHNL)) EQL 0 ) THEN RETURN -1 ELSE IF NOT .T THEN (FSTATUS<FIOERR>_1; RETURN .T);
END;
% DECREASE CHAR COUNT BY 1 %
FICNT_.FICNT-1;
T_ SCANI(FIPTR);
% SEE IF BIT 35 OF WORD WE JUST GOT CHAR FROM IS SET %
TEMP_.(@FIPTR)<0,36>;
FSTATUS<FSEQ>_ IF .TEMP THEN 1 ELSE .FSTATUS<FIS35>;
FSTATUS<FPGMK>_(.TEMP EQL #064321400001);
FSTATUS<FIS35>_.TEMP;
.T
END
END;
ROUTINE PUTCHAR(CHAR)=
BEGIN
MACHOP TTCALL=#051;
TTCALL(1,CHAR);
END;
GLOBAL ROUTINE CLOSE(CHNL)=
BEGIN
%(
THE FUNCTION HERE IS TO CLOSE THE SPECIFIED CHANNEL AND
RELESASE THE DEVICE. ALL RELEVANT STATUS BITS OF THE
CHANNEL TABLE ENTRY ARE CLEARED
)%
MACRO CLOS=#070$, RELEAS=#071$;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
LOCAL T;
T_1;
IF INVALID(.CHNL,21) THEN 21^18 ELSE
IF .CHNL EQL 0 THEN 1 ELSE
(REGISTER F;
F_.FSTATUS;
IF (.F AND (XFUOPEN+XFROPEN+XFWOPEN)) NEQ 0 THEN
BEGIN
XCT(CLOS,.CHNL-1,0);
F_.F AND NOT (XFUOPEN+XFROPEN+XFWOPEN);
IF (T_.FNEWPR) NEQ 0 THEN
(IF .FPROT NEQ .T<0,9> THEN T_RENAME(.CHNL,0,0,.T<0,9>));
XCT(RELEAS,.CHNL-1,0);
F<FDEVAS>_0;
%(
IF REWIND ALLOWED, WE TURN OFF ENDFILE BITS OF INPUT
FILES. IF REWIND NOT ALLOWED, WE MARK CHANNEL
AS UNREADABLE AND UNWRITEABLE.
)%
F_.F AND NOT (XFIOERR+XFIS35+XFSET35+XFSEQ+XFPGMK);
IF .F<FYREW> THEN
%(
REWIND IS ALLOWED
)%
BEGIN
F<FEOF>_0; %TURN OFF ENDFILE BIT%
% IF OUTPUT CHANNEL WE DO NOT WANT TO RESET DUMMY BIT %
END
ELSE
BEGIN
%(
REWIND NOT ALLOWED
)%
F_.F AND NOT (XFYUPDAT+XFYREAD+XFYWRITE);
END;
END;
FSTATUS_.F;
.T)
END;
GLOBAL ROUTINE ENDALL=
BEGIN
INCR I FROM 1 TO .CHNLMAX DO CLOSE(.I);
1
END;
GLOBAL ROUTINE GETSTAT(CHNL)=
BEGIN
IF .CHNL LSS 0 OR .CHNL GTR .CHNLMAX THEN (1^35) ELSE
IF .CHNL EQL 0 THEN 0 ELSE
.CHNLTAB[.CHNL,13]
END;
GLOBAL ROUTINE SET35(CHNL)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF INVALID(.CHNL,19) THEN 19^18 ELSE
IF .FMODE GTR 1 THEN IOERR(20) ELSE
IF .CHNL EQL 0 THEN 1 ELSE (FSTATUS<FSET35>_1)
END;
GLOBAL ROUTINE PUTMSG(MSG)=
%(
THIS IS A SNEAKY ROUTINE. WHAT IT DOES IS DETERMINE THE
NUMBER OF PARAMETERS IT HAS BEEN GIVEN BY EXAMINING
THE "SUB" INSTRUCTION WHICH IS POINTED TO BY THE RETURN
ADDRESS IN THE STACK. IT THEN GOES BACK THIS MANY
POSITIONS AND DOES A TTYPUTS OF THE STRING STACKED
THERE. THE SNEAKY WAY IT DOES THIS IS ATTRIBUTED TO
BILL WULF. IF IT DOESN'T WORK YOU CAN BLAME HIM. IF
IT DOES, YOU MAY APPLAUD.
)%
BEGIN
LOCAL N,SSAV;
N_ IF .(@(MSG+1 %THE RETURN ADDRESS%))<27,9> %THE OPCODE%
NEQ #274 %A SUBTRACT INSTR% THEN 0 ELSE
.(@@(MSG+1))<0,18> %THE WORD POINTED TO
BY THE ADDR OF THE SUBTRACT%;
SSAV_.(MSG+1)<29,7>; % SAVE STATE BITS %
IF .N GTR 0 THEN (IF .MSG<1,7> NEQ 0 THEN (MSG+1)<29,7>_0;TTYPUTS(MSG-(.N-1)));
(MSG+1)<29,7>_.SSAV; % RESTORE STATE BITS %
END;
GLOBAL ROUTINE RETABLE=
BEGIN
CHNLMAX_TABMAX; % NUMBER OF CHANNELS %
CHNLTAB_TABSIZ; % SIZE OF ENTRY %
INCR J FROM 1 TO TABMAX DO % STEPS THRU CHNLS %
( BIND VECTOR CHAN=CHNLTAB[.J,0]<0,36>;
INCR I TO TABSIZ DO % STEPS THRU ENTRY %
CHAN[.I]_0);
INCR J FROM 1 TO TABMAX DO CHNLTAB[.J,13]<FNSET>_1;
DEFAULTS();
END;
GLOBAL ROUTINE GETSW(CHNL)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF INVALID(.CHNL,16) THEN 0 ELSE
IF .CHNL EQL 0 THEN 0 ELSE
.FSWITCH
END;
GLOBAL ROUTINE DUMCHN(CHNL,TYPE)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
IF INVALID(.CHNL,15) THEN 15^18 ELSE
IF .CHNL EQL 0 THEN 1 ELSE
(FSTATUS<FYDUMMY>_.TYPE; 1)
END;
GLOBAL ROUTINE OUTMSG(MSG)=
BEGIN
%(
THIS ROUTINE IS CALLED BY SPECIFYING A CHANNEL NUMBER
AND A SERIES OF STRINGS ENCLOSED IN QUOTES. THE ROUTINE
DETERMINES THE NUMBER OF SUCH STRINGS AND WRITES THE
ENTIRE SET TO THE SPECIFIED CHANNEL.
)%
LOCAL T,N,P,CHNL,ERR;
N_ IF .(@(MSG+1))<27,9> NEQ #274 THEN 0 ELSE
(.(@@(MSG+1))<0,18>)-1;
CHNL_.(MSG-.N)<0,36>;
P_(MSG-.N)<0,7>;
INCR I FROM 1 TO .N*5 DO
IF (T_SCANI(P)) EQL 0 THEN EXITLOOP ELSE IF NOT (ERR_WRITE(.CHNL,.T)) THEN RETURN .ERR;
1
END;
GLOBAL ROUTINE IOPACK(FROMLOC,CNT)=
BEGIN
LOCAL PTR,ACC;
PTR_(.FROMLOC)<36,7>;
FROMLOC_ACC<36,6>;
ACC_0; % CLEAR ACC %
DECR I FROM .CNT-1 TO 0 DO REPLACEI(FROMLOC, SIXBIT(SCANI(PTR)));
.ACC
END;
GLOBAL ROUTINE CMUDEC(PROJ,PROG)=
BEGIN
LOCAL T,P1,P2,PTR;
P1_P2_0;
IF .PROJ NEQ 0 THEN
BEGIN
PTR_PROJ<36,7>;
P1_((SCANI(PTR)-"A")*1000)
+((SCANI(PTR)-"0")*100)
+((SCANI(PTR)-"0")*10)
+((SCANI(PTR)-"0"))
+9;
END;
IF .PROG NEQ 0 THEN
BEGIN
PTR_PROG<36,7>;
P2_((SCANI(PTR)-"A")*9360) % *36*26*10 %
+((SCANI(PTR)-"A")*360) % *36*10 %
+((SCANI(PTR)-"0")*36)
+((IF (T_SCANI(PTR)) LSS "A" THEN
(.T-"0") ELSE (.T-"A"+10)));
END;
T<18,18>_.P1<0,18>;
T<0,18>_.P2<0,18>;
.T
END;
GLOBAL ROUTINE RENAME (CHNL,FILE, EXT, PROT)=
BEGIN
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
LOCAL PTR1, PTR2, TEMP;
MACRO RENAME=#055$,CLOS=#070$;
IF .CHNL EQL 0 THEN 1 ELSE
IF INVALID(.CHNL,25) THEN 25^18 ELSE
BEGIN
IF .FSTATUS<FUOPEN> OR .FSTATUS<FWOPEN> OR .FSTATUS<FROPEN> THEN
BEGIN
XCT (CLOS,.CHNL-1,0);
FSTATUS<FUOPEN>_FSTATUS<FWOPEN>_FSTATUS<FROPEN>_0;
END;
IF .FILE GTR 0 THEN
(IF ..FILE NEQ 0 THEN
FFILE_IOPACK(@FILE,6);
) ELSE IF .FILE LSS 0 THEN FFILE_FEXT_0;
IF .EXT NEQ 0 THEN
IF ..EXT NEQ 0 THEN
FEXT_IOPACK(@EXT,3);
IF .PROT NEQ 0 THEN FPROT_.PROT;
IF XCTSKIP(RENAME,@CHNL-1,FFILE) THEN 1 ELSE
IOERR( SELECT .FERR OF
NSET
1: 34;
2: 35;
3: 36;
4: 37;
5: 38;
7: 39;
OTHERWISE: 26;
TESN)
END
END;
GLOBAL ROUTINE LOOKUP(CHNL)=
BEGIN
MACRO LOOKUP=#076$;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
XCTSKIP(LOOKUP,@CHNL-1,FFILE)
END;
GLOBAL ROUTINE ENTER(CHNL)=
BEGIN
MACRO ENTER=#077$;
BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
XCTSKIP(ENTER,@CHNL-1,FFILE)
END;
END ELUDOM