Trailing-Edge
-
PDP-10 Archives
-
BB-J939D-BM
-
binary/ezio10.b36
There are 6 other files named ezio10.b36 in the archive. Click here to see a list.
!<BLF/LOWERCASE_USER>
MODULE ezio10 (OTS = '',
LANGUAGE (BLISS36),
IDENT = '1(4)'
%IF %VARIANT
%THEN
,
BLISS10_REGS
%FI
) =
BEGIN
! Functional description:
! Provides basic file and tty i/o services to bliss-36
! Programs.
!
! COPYRIGHT (c) 1977, 1978 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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.
!
!++
! FACILITY: A transportable, Easy to use, I/O interface (EZIO)
!
! ABSTRACT:
! Provides basic file and TTY I/O services to BLISS-36 programs.
!
! ENVIRONMENT: TOPS-10 user program subroutine.
!
! AUTHOR: Paul Dickson & Bruce Dawson, CREATION DATE: sometime in 1977
!
! MODIFIED BY:
!
! Bruce Dawson, 24-July-78 : VERSION 0(1)
! 01 - FILIN was returning -1 when it got EOF in the process of getting
! another buffer. However, there may still be data in the buffer, so
! the returning of -1 was delayed until the next request for a buffer.
!
! 02 FILOPN was only checking the low order bit to determine input or
! output. The documentation says only 1 or 0 is allowed. The check
! was made more strigent.
!
! 03 FILIN apparently never worked after the functionality to ignore
! line numbers was added. It should work now.
!
! Bruce Dawson, 4-Oct-78 : version 1(4)
! 04 Edit 03 didn't quite do it all. One expression in FILIN was
! undeleted. Also, EOF was initialized for a channel in FILOPN.
!
!
!--
!
! TABLE OF CONTENTS
!
FORWARD ROUTINE
filcls, ! Closes a file.
filin, ! Gets one line from a file.
filopn, ! Opens a file.
filout, ! Writes a string to a file.
getoct, ! Picks up an octal word.
getsix; ! Picks up a sixbit word.
FIELD
words =
SET
w0 = [0, 0, 36, 0],
w1 = [1, 0, 36, 0],
w2 = [2, 0, 36, 0],
w3 = [3, 0, 36, 0]
TES,
bufh =
SET
bufptr = [1, 0, 36, 0], ! Byte pointer into buffer.
bufcnt = [2, 0, 36, 0], ! Count of bytes.
eof = [3, 0, 1, 0] ! EOF indicator bit !A001
TES,
opnf =
SET
statbits = [0, 0, 36, 0], ! Status bits.
device = [1, 0, 36, 0], ! Device name.
obufh = [2, 18, 18, 0], ! Output buffer header.
ibufh = [2, 0, 18, 0] ! Input buffer header.
TES,
lookf =
SET
filename = [0, 0, 36, 0], ! File name.
ext = [1, 18, 18, 0], ! Extension.
proj = [3, 18, 18, 0], ! Project number.
prog = [3, 0, 18, 0] ! Programmer number.
TES;
LITERAL
NUMCHANS = 3, ! Number of channels open at once
! (-1 excluded)
failure = 0, ! Return codes.
success = 1,
gotdev = 1, ! Codes for parser action.
gotfil = 2,
gotext = 3,
gotp = 4,
gotpn = 5,
goterr = 0;
STRUCTURE
matrix [r, c; nr, nc] =
[nr*nc]
(matrix + r*nc + c)<0, 36>;
!<BLF/NOFORMAT>
BIND
action = UPLIT( ! Parser action table.
gotdev, gotfil, gotfil, 0, 0, gotfil, !
0, gotfil, gotfil, 0, 0, gotfil, !
0, 0, gotext, 0, 0, gotext, !
0, 0, 0, gotp, 0, 0, !
0, 0, 0, 0, gotpn, 0) : matrix[5,6];
!<BLF/FORMAT>
OWN
carr_return : INITIAL(%O'15'), !
linefeed : INITIAL(%O'12'), !
! io : BLOCKVECTOR [NUMCHANS, 3] ! Buffer headers go here. !D001
! FIELD (words, bufh) INITIAL( REP NUMCHANS*3 OF (0)), !D001
io : BLOCKVECTOR [NUMCHANS, 4] ! Buffer headers go here. !A001
FIELD (words, bufh) INITIAL( REP NUMCHANS*4 OF (0)), !A001
unseen, ! Unscanned length of filespec.
first : INITIAL(1), ! First-time flag.
spec; ! Pointer to filespec.
LITERAL
openuuo = %O'50', ! Monitor calls.
renameuuo = %O'55',
lookupuuo = %O'76',
enteruuo = %O'77',
releaseuuo = %O'71',
ttcall = %O'51',
calli = %O'47',
inuuo = %O'56',
outuuo = %O'57',
outchr = %O'1', ! TTCALL codes.
inchwl = %O'4',
reset = %O'0'; ! CALLI codes.
MACRO
bldop (op, ac, y) =
BEGIN
LOCAL inst_;
inst_ = 0;
inst_<27,9> = op;
inst_<23,4> = ac;
inst_<0,18> = y;
machop(%O'256',0,inst_)
END%,
bldskip (op, ac, y) =
BEGIN
LOCAL inst_;
inst_ = 0;
inst_<27,9> = op;
inst_<23,4> = ac;
inst_<0,18> = y;
machskip(%O'256',0,inst_)
END%;
MACRO
put_char (arg) =
BEGIN
CH$WCHAR_A (arg, io [.chan, bufptr]);
IF (io [.chan, bufcnt] = .io [.chan, bufcnt] -1) LEQ 0
THEN
IF bldskip (outuuo, .chan, 0)
THEN RETURN failure
END %;
BUILTIN
machop,
machskip;
GLOBAL ROUTINE filcls (chan) =
!+
! Functional description:
! Closes a file previously opened by filopn.
!
! Inputs:
! Chan: a channel number.
!-
BEGIN
IF .chan LSS 0
THEN
RETURN;
IO[.CHAN,EOF] = 0;
bldop (releaseuuo, .chan, 0);
RETURN success
END;
GLOBAL ROUTINE filin (chan, len, stgptr) =
!+
! Functional description:
! Inputs one line from the specified channel.
!
! Inputs:
! Chan: channel number. -1 is tty.
! Len: length of string for buffer.
! Stgptr: string pointer.
!
! Value:
! Count of characters read. -1 means eof was hit.
!
! Discussion:
! Characters are read until a linefeed is hit, or
! The string is filled, whichever comes first. if
! The string is too short, the next call will pick
! Up where the previous one left off.
! Line numbers (and the tab following) are skipped over.
!-
BEGIN
LOCAL
ptr, ! Pointer to buffer.
ch, ! A character.
count; ! Count of chars read.
ptr = .stgptr; ! Initialize.
count = 0;
IF .chan LSS 0 ! Tty?
THEN
BEGIN
INCR k FROM 1 TO .len DO
BEGIN
machop (ttcall, inchwl, ch);
CH$WCHAR_A (.ch, ptr);
count = .count + 1;
IF .ch EQL .linefeed
THEN
BEGIN
ch = CH$RCHAR (CH$PLUS (.ptr, -2));
IF .ch GEQ %O'13' AND !
.ch LEQ %O'15'
THEN
RETURN .count - 2 ! Trime cr/ff/vt,lf
ELSE
RETURN .count - 1; ! Trim lf only.
END;
END;
IF .ch GEQ %O'13' AND .ch LEQ %O'15'
THEN
RETURN .len - 1
ELSE
RETURN .len
END;
WHILE .count LSS .len DO
BEGIN
! Read in a new buffer if necessary
IF .io [.chan, bufcnt] leq 0
THEN
! IF bldskip (inuuo, .chan, 0) !D001
! THEN !D001
! RETURN -1 !D001
! ELSE !D001
! io [.chan, bufcnt] = .io [.chan, bufcnt] - 1; !D001
! !D001
BEGIN !A001
LOCAL !A003
buf : ref vector; ! Pointer to buffer !A003
! Return if EOF set by prior input !A001
IF .io[.chan, eof] THEN RETURN -1; !A001
! If the INUUO skips, then the last block in the file was read
io [.chan, bufptr] = %O'4400000000'; !A003
IF bldskip (inuuo, .chan, 0) !A001
THEN io[.chan, eof] = 1; !A001
! Change all sequence numbers in the buffer to nulls. !A003
! Note that at this point (after the INUUO), the buffer !A003
! count and pointer are in terms of words. !A003
buf = .io [.chan, bufptr] + 1; !A003
INCR i from 0 to .io [.chan, bufcnt] - 1 do !A003
IF .buf[.i] !A003
THEN !A003
BEGIN ! If line # bit on, then clear word !A003
buf[.i] = 0; !A003
ch$wchar (0, ch$ptr(buf[.i+1])); ! Clear tab !A003
END; !A003
! Make the count and pointer in the buffer header be !A003
! for characters instead of words. !A003
io[.chan, bufptr] = ch$ptr(.io[.chan, bufptr] + 1); !A003
io[.chan, bufcnt] = .io[.chan, bufcnt] * 5; !A003
END; !A001
ch = CH$RCHAR_A (io [.chan, bufptr]); ! Read a character.
io [.chan, bufcnt] = .io [.chan, bufcnt] - 1;
IF .ch NEQ 0 ! Skip nulls.
THEN
BEGIN
CH$WCHAR_A (.ch, ptr); ! Put character in caller's buffer.
count = .count + 1;
END;
IF .ch EQL .linefeed
THEN
BEGIN
ch = CH$RCHAR (CH$PLUS (.ptr, -2));
IF .ch GEQ %O'13' AND
.ch LEQ %O'15'
THEN
RETURN .count - 2 ! Trim cr/ff/vt,lf
ELSE
RETURN .count - 1; ! Trim lf only.
END;
! Return count if LF is not the last thing in the buffer. If
! no characters are in the buffer (don't forget about NULs), then
! return EOF.
IF .IO[.CHAN,EOF] AND .COUNT EQL 0 THEN RETURN -1; !A004
IF .IO[.CHAN,EOF] THEN RETURN .COUNT; !D003!A004
END;
! If we managed to fill up the caller's buffer, then we must
! check the last character in the buffer. This character must
! be effectively deleted if it is a carriage control character.
IF .ch GEQ %O'13' AND .ch LEQ %O'15'
THEN
RETURN .len - 1
ELSE
RETURN .len
END;
GLOBAL ROUTINE filopn (chan, speclen, specptr, output) =
!+
! Functional description:
! Opens a file.
!
! Inputs:
! Chan: a channel number from 0 to 15.
! Speclen: length of the filespec.
! Specptr: string pointer to a filespec of the form:
! Device:filnam.ext[p,pn]
! With the usual defaults.
! Output: low-order bit is 1 for output. bits <1,4> are mode.
!
! Value:
! 1 If successful. otherwise 0.
!-
BEGIN
LOCAL
state, ! State of the parser.
sep, ! Code of seperator.
w, ! A word with a lexeme in it.
lookarg : ! Lookup/enter arg block
BLOCK [4] FIELD (words, lookf),
opnarg : ! Open arg block.
BLOCK [3] FIELD (words, opnf);
IF .CHAN GTR NUMCHANS-1
THEN RETURN FAILURE;
IF .first ! Initialize everything once.
THEN
BEGIN
first = 0;
machop (calli, 0, reset)
END;
IF .chan LSS 0 ! TTY?
THEN
RETURN success;
state = 0; ! Initialize.
spec = .specptr;
unseen = .speclen;
opnarg [device] = %sixbit'DSK '; ! Move in defaults.
opnarg [statbits] = 0;
opnarg [obufh] = opnarg [ibufh] = 0;
io [.chan, w0] = io [.chan, w1] = io [.chan, w2] = 0;
io [.chan, eof] = 0;
lookarg [w0] = lookarg [w1] = lookarg [w2] = lookarg [w3] = 0;
WHILE .state LSS 5 DO
BEGIN
sep = (IF .state LSS 3 THEN getsix ELSE getoct) (w);
CASE .action [.state, .sep] FROM 0 TO 5 OF
SET
[gotdev] :
opnarg [device] = .w;
[gotfil] :
lookarg [filename] = .w;
[gotext] :
lookarg [ext] = .w<18, 18>;
[gotp] :
lookarg [proj] = .w;
[gotpn] :
lookarg [prog] = .w;
[goterr] :
RETURN failure
TES;
state = (IF .sep LSS 5 THEN .sep + 1 ELSE .sep)
END;
IF .output EQL 1 ! Set up buffers. !R002
THEN
opnarg [obufh] = io [.chan, w0]
ELSE
opnarg [ibufh] = io [.chan, w0];
IF NOT bldskip (openuuo, .chan, opnarg)
THEN
RETURN failure;
w = (IF .output EQL 1 THEN enteruuo ELSE lookupuuo); !R002
IF NOT bldskip (.w, .chan, lookarg)
THEN
BEGIN
bldop (releaseuuo, .chan, 0);
RETURN failure
END;
IF .output EQL 1 !R002
THEN
IF bldskip (outuuo, .chan, 0)
THEN
RETURN failure;
RETURN success
END;
GLOBAL ROUTINE filout (chan, len, stgptr) =
!+
! Functional description:
! Outputs a string on the specified channel.
!
! Inputs:
! Chan: Channel number. -1 is TTY.
! Len: Length of string. If negative, current
! buffer is output.
! Stgptr: String pointer.
!
! Value:
! 1 If everything goes Ok. Otherwise 0.
!-
BEGIN
LOCAL
ch, ! A character.
ptr; ! Pointer to next char to send.
ptr = .stgptr; ! Initialize.
IF .chan LSS 0 ! TTY?
THEN
BEGIN
INCR k FROM 1 TO .len DO
BEGIN
ch = CH$RCHAR_A (ptr);
bldop (ttcall, outchr, ch)
END;
bldop (ttcall, outchr, carr_return);
bldop (ttcall, outchr, linefeed);
RETURN success
END;
IF .len LSS 0 ! Force block?
THEN
RETURN NOT bldskip (outuuo, .chan, 0);
INCR k FROM 1 TO .len DO
BEGIN
put_char (CH$RCHAR_A (ptr));
END;
put_char (.carr_return);
put_char (.linefeed);
RETURN success
END;
ROUTINE getoct (wadr) =
!+
! Functional description:
! Scans an octal word from the filespec.
!
! Inputs:
! Wadr: address of where the word goes.
!
! Value:
! A code indicating the reason for stopping. this
! Is useful to the parser.
!-
BEGIN
LOCAL
len,
ch; ! A character.
BIND
w = .wadr; ! The destination.
w = len = 0; ! Initialize.
WHILE .unseen GTR 0 DO
BEGIN
ch = CH$RCHAR_A (spec); ! Get a character.
IF .ch GEQ %C'0' AND .ch LEQ %C'7' ! Test numeric.
THEN
w = .w^3 + (.ch - %C'0')
ELSE
IF .ch EQL %C','
THEN
RETURN 3 ! Test stopping.
ELSE
RETURN 4;
unseen = .unseen - 1
END;
RETURN 5
END;
ROUTINE getsix (wadr) =
!+
! Functional description:
! Scans a sixbit word from the filespec.
!
! Inputs:
! Wadr: address of where the word goes.
!
! Value:
! A code indicating the reason for stopping. this
! Is useful to the parser.
!-
BEGIN
LOCAL
vp, ! Pointer to output string.
len, ! Count of characters taken.
ch; ! A character.
BIND
w = .wadr; ! The destination.
w = len = 0; ! Initialize.
vp = CH$PTR (w, 0, 6);
WHILE .unseen GTR 0 DO
BEGIN
ch = CH$RCHAR_A (spec); ! Get a character.
IF .ch GEQ %C'a' AND .ch LEQ %C'z'
THEN
ch = .ch - 32; ! Uppercase.
SELECTONE .ch ! See if should stop.
OF
SET
[%C':'] :
RETURN 0;
[%C'.'] :
RETURN 1;
[%C'['] :
RETURN 2;
[OTHERWISE] :
BEGIN
IF .ch LEQ 32
THEN
RETURN 5;
IF .len LSS 6
THEN
BEGIN
len = .len + 1;
CH$WCHAR_A (.ch + 32, vp)
END
END
TES;
unseen = .unseen - 1
END;
RETURN 5
END;
END
ELUDOM