Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
RTITLE IO
; Edit: 302
SUBTTL Written by Olof Bj`rner Dec 1973
ERRMAC(IO)
MACINIT
PROCINIT(IO)
COMMENT ;
This module contains all initial actions required by a
file generation statement. There are three entries for each type
of file: INFILE, OUTFILE, PRINTFILE and DIRECTFILE.
The first entry, <filetype>%D, contains the declaration coding.
This entry consists chiefly of a branch to CPCD preceded by
loading of the prefix level to XSAC.
The second entry, <filetype>%S, contains the actions for this class.
The subroutine SETUPFILE is used for all common file actions.
The third entry, <filetype>%I, is the INNER coding which
in this case consists of a branch to CPE0.
These three entries are also present for FILE but the
statement coding, IOFI%S is empty, i.e. all actions are
deferred to the INNER level.
MODULE ORGANIZATION:
1. Local subroutines
2. SIMULA procedures
3. File object generation code and symbol tables
;
SUBTTL RECORDS USED IN IO HANDLING
Comment ;
Name Defined Physical Explanation
in location
ZSW SIMRPA object prog Runswitch record created by compiler
ZFS SIMRPA Static area IOSPEC table
ZFI SIMRPA Dynamic area File object
ZBH SIMRPA Static area Buffer area containing buffer ring header
and buffer ring
ZYS SIMRPA Dynamic area SFD path argument
ZXB SIMRPA Dynamic area Extended lookup/Enter block
ZFD OCIN Static area File specification record
Organization of low segment:
I-------------------------I
I I
. .
. SIMULA program .
. .
I I
I-------------------------I <--- .JBOPS
I I
. .
. Static area .
. .
I I
I-------------------------I <--- YOCBST
I I
. .
. Buffer areas .
. .
I I
I-------------------------I <--- YIOSPC
I I
. .
. IOSPEC table .
. .
I I
I-------------------------I
I I
. .
. Buffer areas .
. continued .
I I
I-------------------------I <--- YSABOT
I I
. .
. Dynamic area .
. .
I I
I-------------------------I <--- YSATOP
ZBH record - buffer area
=========================
Word no:
I------------------I------------------I
0 I ZBHLEN I ZBHLNK I Bit 0: ZBHFRE, Bit 18: ZBHCON
I------------------I------------------I
1 I I ZBHZBU I Bit 0: ZBHUSE
I------------------I------------------I
2 I ZBHBUP I
I-------------------------------------I
3 I ZBHCNT I
I-------------------------------------I
4 I ZBUSTA I
I------------------I------------------I
5 I ZBUSIZ I ZBUZBU I Bit 0: ZBUUSE
I------------------I------------------I
6 I I ZBUWCT I
I------------------I------------------I
7 I ZBUDAT I
I-------------------------------------I
Words 1-3 comprise the buffer ring header and are immediately
followed by the buffer ring.
Explanations:
ZBHFRE =1 means that this buffer area is available
ZBHLEN includes ZBHFRE and contains total length of
this buffer area. The length is positive if
the area is in use else negative.
ZBHCON =1 if this area immediately follows the
previous area (it might be preceded by the
IOSPEC table)
ZBHLNK pointer to next buffer area or -1 if
it is the last buffer area
ZBHUSE use bit for the buffer ring
ZBHZBU pointer to current buffer
ZBHBUP buffer byte pointer
ZBHCNT no of bytes remaining in buffer
ZBUSTA file status
ZBUUSE use bit for this buffer
ZBUSIZ file size
ZBUZBU pointer to next buffer in the ring
ZBUWCT word count for this buffer
ZBUDAT data
ZSW - runswitch record
======================
Word no:
I-------------------------------------I
0 I ZSWDEV I
I-------------------------------------I
1 I ZSWFIL I
I------------------I------------------I
2 I ZSWEXT I I
I------------------I------------------I
3 I I
I-------------------------------------I
4 I ZSWPPN I
I-------------------------------------I
Explanations:
Words 1-4 comprise the LOOKUP block for the
specification file, specified in the R-switch
during compilation.
ZSWDEV device name, must be TTY or DSK(n)
ZSWFIL file name
ZSWEXT extension
ZSWPPN ppn
ZFD - FILE DEFINITION RECORD
============================
This record is built during the scan of a file definition
and later moved to ZFS or ZFI.
I-------------------------------------I
YOCFD: I ZFDDEV I
I-------------------------------------I
+1 I ZFDFIL I
I------------------I------------------I
+2 I ZFDEXT I I
I------------------I------------------I
+3 I I Bits 0-8: ZFDPT
I------------------I------------------I
+4 I ZFDPRJ I ZFDPRG I
I------------------I------------------I
+5 I ZFDPNT I
I-------------------------------------I
+6 I ZFDSFD I
I-------------------------------------I
Explanations
ZFDDEV device name
ZFDFIL file name
ZFDEXT extension
ZFDPT protection
ZFDPRJ project number
ZFDPRT programmer number
ZFDPNT byte pointer to first SFD name in file descriptor
ZFDSFD number of SFD names
ZFI record - file object
========================
Word no:
I-------------------------------------I
I I
0-1 I record header I
I I
I------------------I------------------I
2 I ZFIFLN I ZFIFTR I Bits 0-36: ZFISPC
I------------------I------------------I
3 I I
I-------------------------------------I
4 I ZFIIMG I
I------------------I------------------I
5 I I ZFIICP I
I------------------I------------------I
6 I flags I
I-------------------------------------I
7 I ZIFEND I also ZDFEND
I------------------I------------------I
10 I I ZFIBUF I Bits 7-12: ZFICHN
I------------------I------------------I
11 I ZFIKAR I
I-------------------------------------I
12 I ZFISTI I
I-------------------------------------I
13 I ZFIDVN I
I------------------I------------------I
14 I ZFIOBH I ZFIIBH I
I------------------I------------------I
15 I ZFIFIL I
I------------------I------------------I
16 I ZFIEXT I I
I------------------I------------------I
17 I I Bits 0-8: ZFIPT
I------------------I------------------I
20 I ZFIPRJ I ZFIPRG I Bits 0-35: ZFIARG
I------------------I------------------I
21 I ZFINAM I
I-------------------------------------I
22 I ZFIPPN I
I-------------------------------------I
23 I ZFIBFS I
I-------------------------------------I
Explanations:
Words 2-3 comprise the text reference variable to the file
specifications given at file creation (NEW ...file(specif)).
Words 4-5 contain the text reference variable to the image of
this file.
Words 12-14 contain the argument block to the OPEN UUO.
Words 15-20 contain the argument block to the LOOKUP/ENTER UUO:s.
ZFIFLN is the length of the text variable
containing the parameter to FILE.
ZFIFTR pointer to this variable
ZFIIMG text variable to image
ZFIICP current position (POS-1) for image
Word 6 contains various flags:
bit no name meaning if 1
------ ---- ------------
0 ZFIOPN file is open (set by .IOOP)
1 ZFIIF file is an infile
2 ZFIOF file is an outfile or a printfile
3 ZFIPF file is a printfile
4 ZFIDF file is a directfile
5 ZFIIN file can do input (infile and directfile)
6 ZFIOUT file can do output (outfile, printfile and directfile)
7 ZFISFD file has a SFD path
8 ZFIDE file has an extended LOOKUP/ENTER block (ZXB)
9 ZFIAPP file is written in append mode
10 ZFIEND temporary end of file reached
14 ZFIWDB [24] image in file always starts on a word boundary
15 ZFINUM [24] file has standard line numbers (LINED format). Implies ZFIWDB
16 ZFIRON [24] File is read only (ACCESS:RONLY)
17 ZFILBO [44] Last call was Breakoutimage, not Outimage
18 ZFIFND [61] On for special call with no dialogue
19 ZFIPGT [63] Put or Get in progress on file (Not Out- or Inimage)
ZIFEND end of file flag
(set by INIMAGE when INIMAGE is called
and ZFIEND is set (infile only))
ZFICHN channel number in AC position
ZFIBUF number of buffers in buffer ring,
obtained through the DEVSIZ UUO or
from the B-switch
ZFIKAR device characteristics, obtained through
the DEVCHR UUO
ZFISTI initial file status, 1 indicates ASCII file.
ZFIDVN device name (SIXBIT)
ZFIOBH address to output buffer header block
ZFIIBH address to input buffer header block
ZFIFIL file name (SIXBIT code), or, if 0 in left half,
address to ZXB record
ZFIEXT file extension
ZFIPT protection code
ZFIPRJ project number
ZFIPRG programmer number
ZFIARG address to SFD path (ZYS record)
ZFINAM logical file name
ZFIPPN save area for ppn between successive
LOOKUP or ENTER UUO:s
ZFIBFS buffer size, obtained from the DEVSIZ UUO.
ZOF record - file object for outfile
====================================
Word no:
I------------------I------------------I
0 I I
. .
. ZFI .
. .
23 I I
I------------------I------------------I
24 I ZOFBLK I ZOFLIM I
I------------------I------------------I
Explanations:
ZOFBLK number of written blocks
ZOFLIM max no of blocks to be written
(set by user through the L-switch)
ZPF record - file object for printfile
======================================
Word no:
I-------------------------------------I
0 I I
. .
. ZFI .
. .
23 I I
I-------------------------------------I
24 I ZOF I
I------------------I------------------I
25 I ZPFSP I ZPFLP I
I------------------I------------------I
26 I ZPFLL I ZPFLIN I
I------------------I------------------I
Explanations:
ZPFSP spacing amount, set by user with the
SPACING procedure and defaulted to 1.
ZPFLP linesperpage amount, set by user with
the LINESPERPAGE procedure and
defaulted to 60.
ZPFLL number of last printed line
ZPFLIN number of next line, value of LINE
attribute.
ZDF record - file object for directfile
=======================================
Word no:
I-------------------------------------I
0 I I
. .
. ZFI .
. .
23 I I
I------------------I------------------I
24 I ZDFIML I ZDFLIM I
I------------------I------------------I
25 I ZDFWCT I ZDFLOC I
I------------------I------------------I
26 I I ZDFBLK I Bit 0: ZDFMOD
I------------------I------------------I Bit 1: ZDFOUT
Explanations:
ZDFIML max image length
ZDFLIM max valid location, i.e. last
written record number
ZDFWCT word count for directfile buffer
ZDFLOC current value of LOCATION
ZDFMOD on if OUTIMAGE has been done on
current directfile buffer
ZDFOUT on if OUTIMAGE was done last, not
INIMAGE
ZDFBLK current external block number in core
ZYS record - SFD path
=====================
Word no:
I-------------------------------------I
0-1 I I
I record header I
I I
I-------------------------------------I
2 I ZYSARG I
I-------------------------------------I
3 I I
I-------------------------------------I
4 I ZYSP1 I
I-------------------------------------I
5 I ZYSSFD I
I-------------------------------------I
. .
. .
Explanations:
This record contains the SFD path for a file and
is pointed at from ZFIARG.
Note that this record can be 6 to 11 words depending
on the number of SFD:s. The last SFD entry is always zero.
ZYSARG argument in SFD path
ZYSP1 ppn
ZYSSFD first SFD name in SIXBIT
ZXB record - extended LOOKUP/ENTER block
========================================
Word no:
I-------------------------------------I
0 I I
I record header I
1 I I
I-------------------------------------I
2 I ZXBARG I
I-------------------------------------I
3 I ZXBP2 I
I-------------------------------------I
4 I ZXBFIL I
I------------------I------------------I
5 I ZXBEXT I I
I------------------I------------------I
6 I ZXBPRT I
I-------------------------------------I
7 I ZXBLNG I
I-------------------------------------I
10 I I
I-------------------------------------I
11 I I
I-------------------------------------I
12 I ZXBLEN I
I-------------------------------------I
13 I ZXBALC I
I-------------------------------------I
EXPLANATIONS
ZXBARG number of words following this word
ZXBP2 ppn
ZXBFIL file name
ZXBEXT extension
ZXBPRT protection code
ZXBLNG file length in words
ZXBLEN estimated file length
ZXBALC allocated file length
ZFS record - IOSPEC table entry
===============================
Word no:
I------------------I------------------I
-1 I ZFSLNK I I
I------------------I------------------I
0 I ZFSNAM I
I-------------------------------------I
1 I ZFSDEV I
I------------------I------------------I
2 I ZFSSIZ I ZFSLIM I
I------------------I------------------I
3 I ZFSIML I flags I
I------------------I------------------I
4 I ZFSFIL I
I------------------I------------------I
5 I ZFSEXT I ZFSBUF I
I------------------I------------------I
6 I I Bits 0-8: ZFSPT
I------------------I------------------I
7 I ZFSPRJ I ZFSPRG I Bits 0-35: ZFSADR
I------------------I------------------I
10 I ZFSARG I
I-------------------------------------I
11 I I
I-------------------------------------I
12 I ZFSPPN I
I-------------------------------------I
13 I ZFSSFD I
I-------------------------------------I
Explanations
ZFSLNK pointer to next ZFS entry or -1 if last
ZFSNAM logical file name
ZFSDEV device name
ZFSSIZ initial file size from S-switch
ZFSLIM max file size from L-switch
ZFSIML directfile image size from I-switch
ZFSAPP append mode switch
ZFSSUB SFD switch
ZFSNUM [24] Line numbers on this file
ZFSWDB [24] Word aligned images in buffer
ZFSRON [24] Read only file
ZFSFIL file name
ZFSEXT extension
ZFSPT protection code
ZFSPRJ project number
ZFSPRG programmer number
ZFSARG argument in SFD path
ZFSPPN ppn in SFD path
ZFSSFD SFD name
;
EXTERN .TXST,.TXSU,.TXVA,.IOIC
TWOSEG
RELOC 400K
IFN QDEBUG,<
IOST: ;LABEL FOR DEBUGGING
>
DEFINE BREAKOUTIMAGE(A)=<
SKPINC ;;CLEAR CONTROL-O
NOP
OUTSTR [ASCIZ/A/]>
edit(24)
DEFINE NORMALIZE(xp)<;;[24] Change byte ptr [010700,,addr] and [700,,addr]
;; to [440700,,addr+1]
IF
TLNE xp,400000 ;;No change if already ok
GOTO FALSE
THEN
HRLI xp,440700
ADDI xp,1
FI
>
DEFINE OUTIMAGE(A)=<
SKPINC
NOP
OUTSTR [ASCIZ/A
/]>
edit(236)
IFN <%ZFIOP>,<PRINTX %ZFIOPN not bit 0 as assumed> ;[236]
DEFINE IFNOTOPEN(x)<;;[236]
SKIPL OFFSET(ZFIOPN)(x)
>
DEFINE IFOPEN(x)<;;[236]
SKIPGE OFFSET(ZFIOPN)(x)
>
COMMENT ;
ERROR MESSSAGES IN THIS MODULE:
===============================
NO MESSAGE
-- -------
0 FILE NOT OPEN
3 TRANSFER FAILURE
4 FILE ALREADY OPEN
5 FILE ALREADY CLOSED
6 CLOSE FAILURE
7 EOF IN INIMAGE
10 EXTERNAL IMAGE TOO LONG
11 TOO BIG IMAGE
12 EJECT ARGUMENT OUT OF RANGE
13 SPACING ARGUMENT OUT OF RANGE
14 OUTPUT FIELD WIDTH OUT OF RANGE
15 OUTPUT LIMIT EXCEEDED
16 LOCATION NOT POSITIVE
;
SUBTTL ;[24] Local definitions
edit(24)
BUP== OFFSET(ZBHBUP)
CNT== OFFSET(ZBHCNT)
IMG== OFFSET(ZFIIMG)
XLB== XK ;Length of contiguous field in a buffer
XLI== XL ;Length of field remaining to be copied
SUBTTL SUBROUTINE/PROCEDURE NAME DEFINITIONS
COMMENT ;
a) Local subroutines used internally in the IO module
or externally in other run-time modules.
(names not defined here are defined in SIMRTS through
the PROCINIT macro).
;
OPDEF COMPBLOCK [PUSHJ XPDP,.IOCB] ;Computes relative block no in a
;DIRECTFILE
OPDEF COMPPOINTER [PUSHJ XPDP,IOCP] ;Computes image byte pointer
OPDEF COMPSTART [PUSHJ XPDP,.IOCS] ;Computes ext image start in buffer
OPDEF FINDBLOCK [PUSHJ XPDP,IOSETO] ;Positions a DIRECTFILE
OPDEF GETCHR [PUSHJ XPDP,IOGC] ;Picks up next input character
edit(41)
INTERN .IOCLA ;[41] Tests if any file open or
;[41] Closes SYSIN and SYSOUT
;Called at execution end
INTERN .IOFD ;FIELD procedure
INTERN .IOLN ;Checks if logical name already in use
;Called by SIMDDT
OPDEF PUTCHAR [PUSHJ XPDP,.IOPC]
OPDEF PUTOUT [PUSHJ XPDP,.IOPUT]
OPDEF READBLOCK [PUSHJ XPDP,.IORB] ;Inputs next buffer
edit(24)
OPDEF READNEXT [PUSHJ XPDP,IORN] ;[24] Inputs next buffer sequentially
OPDEF SEEKNAME [PUSHJ XPDP,IOSEEK] ;Seeks a logical name in file object
COMMENT ;
B) SIMULA PROCEDURES:
;
INTERN .IOCL ;CLOSE
INTERN .IOEJ ;EJECT
INTERN .IOIG ;INIMAGE
INTERN .IOLI ;LASTITEM
INTERN .IOLT ;LOCATE
INTERN .IOLP ;LINESPERPAGE
INTERN .IOOP ;OPEN
INTERN .IOOG ;OUTIMAGE
INTERN .IOBO ;BREAKOUTIMAGE
INTERN .IOSP ;SPACING
SUBTTL Local subroutine: COMPBLOCK
COMMENT ;
Purpose: To compute the relative block number (ZDFBLK)
from the ordinal image number (ZDFLOC) and the
image size (ZDFIML).
The expression:
((ZDFIML//5)+1)*(LOC-1))//128
is computed.
The quotient+1 is the block number
and the remainder is the offset within the buffer.
Entry: .IOCB
Input argument:
XWAC1 points to file object
Output arguments:
X0 contains ZDFBLK
X1 contains offset within buffer.
Normal exit: RETURN
Error exit: -
Call format: COMPPOINTER
Used routines: -
Used registers: X0,X1,X2
Error messages: -
;
.IOCB::
LF X0,ZDFIML(XWAC1)
IDIVI X0,5 ;Convert to words
CAIE X1,0
ADDI X0,1
LF X2,ZDFLOC(XWAC1)
IMULI X0,-1(X2)
IDIVI X0,200
ADDI X0,1
RETURN
SUBTTL Local subroutine: COMPPOINTER
edit(24)
COMMENT ;[24] Changed to be quicker in the normal case
Purpose: To compute a byte pointer to an image from the
text reference.
Entry: IOCP
Input:
XWAC2-XWAC3 contain the text reference
Output:
XIP contains the byte pointer
XTAC is offset within word [24]
Normal exit: RETURN
Error exit: -
Call format: COMPPOINTER
Used routines: -
Used registers:
XSAC,XTAC
Error messages: -
;
IOCP:
LI XIP,2+OFFSET(ZTVZTE)(XWAC2)
LF XSAC,ZTVSP(,XWAC2)
IF ;No offset
JUMPN XSAC,FALSE
THEN
HRLI XIP,(POINT 7,0,-1)
SETZ XTAC,
RETURN
FI
IDIVI XSAC,5 ;Offset within main text
ADDI XIP,(XSAC) ;Add offset to start of text
HLL XIP, [POINT 7,0,-1
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27](XTAC) ;Select byte pointer
RETURN
SUBTTL Local subroutine: COMPSTART
COMMENT ;
Purpose: To compute the start address in the buffer for
a DIRECTFILE image.
Note that a DIRECTFILE image always starts on
a word boundary.
Entry: .IOCS
Input arguments:
XBH points to the buffer area
-1(XPDP) contains offset to the image within the buffer
Output arguments:
ZBHBUP and ZBHCNT are updated.
Normal exit: RETURN
Error exit: -
Call format: COMPSTART
Used routines: -
Used registers: X0, X1
Error messages: -
;
.IOCS::
L X1,-1(XPDP)
LF X0,ZBHZBU(XBH) ;Get address to buffer
ADDI X0,2(X1) ;Add offset + 2
HRLI X0,(POINT 7,0) ;Set up pointer
SF X0,ZBHBUP(XBH)
LF X0,ZBHZBU(XBH) ;Start of buffer
LF X1,ZBHBUP(XBH) ;Image start
SUBI X0,-202(X1) ;X0:=remainder of words in buffer
IMULI X0,5 ;Convert to characters
SF X0,ZBHCNT(XBH)
RETURN
SUBTTL Local subroutine: FINDBLOCK
COMMENT ;
PURPOSE: TO DO A USETO TO PREPARE FOR OUTPUT OF A DIRECTFILE BLOCK
ENTRY: IOSETO
INPUT ARGUMENTS:
FILE REF IN XWAC1
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: FINDBLOCK
USED ROUTINES: -
USED REGISTER: X0
ERROR MESSAGES: -
;
IOSETO:
LF X0,ZDFBLK(XWAC1) ;DO USETO WITH BLOCK NO
;USED BY LATEST USETI
CAIG X0,0
LI X0,1 ;BLOCK 0 NOT VALID
FILOP (USETO)
RETURN
SUBTTL Local subroutine: GETCHR
edit(24)
COMMENT ;[24] Some changes: Only used for Infile (GETCHD for directfile).
Restructured.
PURPOSE: TO FETCH NEXT BYTE FROM THE INPUT BUFFER.
ALL NULLS AND CARRIAGE RETURNS ARE IGNORED.
THE END OF LINE FLAG IS TURNED ON IF A
BREAK CHARACTER IS FOUND OR IF END OF
FILE OCCURS.
ENTRY: IOGC
INPUT ARGUMENT:
XBH POINTS TO THE BUFFER AREA.
OUTPUT ARGUMENT:
X0 CONTAINS NEXT BYTE.
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: GETCHR
USED ROUTINES: READBLOCK
USED REGISTERS: X0, XTAC
ERROR MESSAGES: -
;
IOGC: PROC
L1():! LOOP
SOSGE CNT(XBH) ;DECREASE BUFFER BYTE COUNTER
GOTO L2
ILDB BUP(XBH) ;FETCH NEXT BYTE
CAILE X0,033
RETURN ;IF NOT BREAK CHARACTER
AS JUMPE TRUE ;[24] Ignore null
CAIN X0,QCR
GOTO TRUE ;IGNORE CARRIAGE RETURN
SA
CAIN X0,QLF
GOTO L9 ;LF IS BREAK CHARACTER
IF ;VT, ALTMODE OR FF
CAIE X0,013
CAIN X0,033
GOTO TRUE
CAIE X0,014
GOTO FALSE
THEN ;BREAK CHARACTER WHICH IS TRANSFERRED TO IMAGE
SETO XTAC,
ELSE
edit(14)
IF ;[14] ^Z
CAIE X0,"Z"-"A"+1
GOTO FALSE
THEN ;Ignore if TTY
IFON ZFITTY(XWAC1)
GOTO L1 ;TO GET END OF FILE
FI FI
RETURN ;if not LF or EOF
L2():!
READBLOCK ;[24]
IFOFF ZFIEND(XWAC1)
GOTO L1
L9():!
;HERE IF LINE FEED OR END OF FILE
SETO XTAC, ;FLAG END OF LINE
LI X0," " ;PAD WITH BLANK
RETURN
EPROC
SUBTTL .IOCLA - Close and test opened files
Comment ;
edit(41)
edit(302)
Purpose: [41] To scan through the channel table and
a) test if any files except SYSIN, SYSOUT or
any SIMDDT input or output file are open or
b) close those other files.
Entry: .IOCLA
Input conditions:
Called from OCEP at execution termination.
Switch SDSCLO off if testing for open files
Switch SDSCLO on if special to be closed
Output arguments:
X0 is 0 if no files open
X0 is -1 if open files exist
SYSIN, SYSOUT and other special files closed
if switch SDSCLO on
Normal exit: RETURN
Error exit: -
Call format: EXEC .IOCLA
Used routines:
.IOCL
Used registers:
X0 working register
X1 address to channel table
X4 no of elements in channel table
XWAC1 file reference
X1-X4 are saved.
Error messages: -
;
.IOCLA: PROC
LOWADR
CFORBID
SAVE <X1,X4,X5>
LOWADR
edit(15)
LI X5,1 ;[15] Loop twice for TTY files
L1():! ;[15]
LI X1,YIOCHTB(XLOW);X1=address to channel table
HRLI X1,-^D16 ;Count of elements in channel table
LOOP ;Through channel table
IF ;This channel still used
SKIPN XWAC1,(X1) ;[302]
GOTO FALSE
THEN ;Close the file(s)
TLNE XWAC1,-1
HLRZ XWAC1,XWAC1 ;[302] Select output side
edit(236)
IFNOTOPEN(XWAC1) ;[236]
GOTO L9
IF ;Special file
CAME XWAC1,YSYSOU(XLOW)
CAMN XWAC1,YSYSIN(XLOW)
GOTO TRUE
CAME XWAC1,YDSUFO(XLOW) ;SIMDDT USE file
CAMN XWAC1,YDSIFO(XLOW) ;SIMDDT @ file
GOTO TRUE
CAME XWAC1,YDSDFO(XLOW)
GOTO FALSE
THEN ;Ok if open, close if SDSCLO
IFON SDSCLO(XLOW)
EXEC .IOCL
ELSE ;A normal file was open
IFON SDSCLO(XLOW)
GOTO L8 ;EXIT
FI
FI
L9():!
AS AOBJN X1,TRUE
SA
edit(15)
SOJGE X5,L1 ;[15] Loop for TTY (or PTY) files
; No special treatment of SYSOUT
TDZA X0,X0 ;Return no open files
L8():! SETO X0,
CALLOW
RETURN
EPROC
SUBTTL .IOFD - FIELD
COMMENT ;
PURPOSE: TO COMPUTE A TEXT REFERENCE TO A FIELD IN THE
CURRENT OR NEXT OUTPUT IMAGE WHICH IS LARGE ENOUGH
TO HOLD THE EDITED VALUE.
ENTRY: .IOFD
CALLING FORMAT IN SIMULA (NOT DIRECTLY ACCESSIBLE):
FIELD(W)
INPUT ARGUMENTS:
XWAC1 CONTAINS THE FILE REFERENCE
XWAC2 CONTAINS FIELD WIDTH, W
OUTPUT ARGUMENTS:
XWAC1 CONTAINS ADDRESS TO NEW TEXT REFERENCE IN YTXZTV
NORMAL EXIT: RETURN
ERROR EXIT: IOERC [41]
USED REGISTERS: XWAC2-6 [76]
USED ROUTINES:
.IOOG (OUTIMAGE), .TXSU(SUB).
ERROR MESSAGES: FIELD ERROR
FILE NOT OPEN
;
.IOFD: PROC
edit(76)
SAVE <XWAC2,XWAC3,XWAC4,XWAC5,XWAC6> ;[76]
LD XWAC3,IMG(XWAC1)
LF XWAC5,ZTVCP(,XWAC3);XWAC5:=POS-1
edit(41)
L1():! ;[41]
LF X0,ZTVLNG(,XWAC3)
SUBI X0,(XWAC2) ;X0:=LENGTH-W
IF ;FIELD WIDTH OUT OF RANGE, I.E.
;W <= 0 OR W> LENGTH
JUMPLE XWAC2,TRUE
JUMPGE X0,FALSE
THEN ;ERROR!
ERRFILE
edit(236)
IFNOTOPEN(XWAC1) ;[41,236]
IOERR 0,File not open
edit(41) ;[41]:
IOERC QDSNIN,14,Output field width out of range
NEWVALUE XWAC2 ;[41]
GOTO L1 ;[41]
FI
CAMLE XWAC5,X0 ;IF POS > LENGTH-W
EXEC .IOOG ;DO OUTIMAGE
LF XWAC5,ZFIICP(XWAC1) ;Reload the position
LI XTAC,XWAC3 ;XTAC:-TEXT REFERENCE
ADDI XWAC5,1
LI XWAC6,(XWAC2) ;XWAC6:=W
EXEC .TXSU ;IMAGE.SUB(POS,W)
LOWADR
STD XWAC3,YTXZTV(XLOW);STORE NEW TEXT REFERENCE
ADDM XWAC2,OFFSET(ZFIICP)(XWAC1);SETPOS(POS+W)
LI XWAC1,YTXZTV(XLOW);ADDRESS TO NEW TEXT REFERENCE
RETURN
EPROC
SUBTTL .IOLN - Find logical name for USE command (SIMDDT)
COMMENT ;
PURPOSE: TO CHECK IF THE LOGICAL NAME IN A SIMDDT
USE COMMAND IS ALREADY USED.
ENTRY: .IOLN
INPUT ARGUMENT:
XWAC2-XWAC3 CONTAIN TEXT VARIABLE FOR THE USE OPERAND
OUTPUT ARGUMENTS:
X2 CONTAINS FILE REF IF ALREADY USED LOGICAL NAME
X2 = 0 IF NOT USED
X2 = -1 IF "USE TTY:" COMMAND
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC .IOLN
USED ROUTINES: GETNAME
SEEKNAME
USED REGISTERS: X1, X2, XWAC2
ERROR MESSAGES: -
;
.IOLN: PROC
SAVE <XNAME,XBYTE>
HRLI XWAC2,440700 ;SET UP POINTER TO USE OPERAND
ADDI XWAC2,2
ST XWAC2,YOCPNT(XLOW)
GETNAME
IF ;DEVICE WAS GIVEN
CAIE XBYTE,":"
GOTO FALSE
THEN IF ;IT WAS TTY
CAME XNAME,[SIXBIT/TTY/]
GOTO FALSE
THEN ;FLAG TTY TO SIMDDT
HRROI X2,-1
GOTO L9
FI
GETNAME
FI
;NOW SEARCH FOR THE LOGICAL NAME
MOVSI X1,-20
HRRI X1,(XLOW)
LOOP ;UNTIL END OF YIOCHTB
;OR NAME FOUND
HLRZ X2,YIOCHTB(X1)
SEEKNAME
GOTO L9 ;FOUND!
HRRZ X2,YIOCHTB(X1)
SEEKNAME
GOTO L9 ;FOUND!
AS INCR X1,TRUE
SA
LI X2,0 ;NOT FOUND
L9():!
RETURN
EPROC
SUBTTL Local macro: GETCHD
COMMENT;
PURPOSE: To get next character from a directfile. Blank is substituted
for null.
OUTPUT: Next character in the parameter ac (default X0).
;
DEFINE GETCHD(X)<
SOSGE CNT(XBH)
EXEC IOGDNB
ILDB X,BUP(XBH)
IF ;;null
JUMPN X,FALSE
THEN ;;Return " "
LI X," "
ELSE ;;Save last char in XSAC
L XSAC,X
FI
>
IOGDNB: PROC
SAVE XSAC
READNEXTBLOCK
SOS CNT(XBH)
RETURN
EPROC
SUBTTL Local subroutine: PUTCHAR
COMMENT ;
PURPOSE: TO STORE A CHARACTER IN THE OUTPUT BUFFER.
ON BUFFER OVERFLOW AN OUT UUO IS EXECUTED.
IF IT IS A DIRECTFILE THE OUT UUO IS PRECEDED
BY A USETO UUO AND READBLOCK IS CALLED TO READ
IN THE NEXT CONSECUTIVE BLOCK IF ANY.
PUTCHAR USES A SUBROUTINE .IONB
WHICH WRITES THE OUTPUT BUFFER WHEN IT BECOMES
FULL. IONB IS ALSO CALLED DIRECTLY FROM
OUTIMAGE (.IOOG-.IOBO).
NOTE THAT IONB ALWAYS RETURNS TO THE INSTRUCTION
PRECEDING THE CALL!
INPUT ARGUMENT:
X0 CONTAINS THE BYTE TO BE STORED
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: PUTCHAR
USED ROUTINES: IONB
ERRFILE
PUTOUT
FINDBLOCK
READBLOCK
USED REGISTERS: X0, X1, XBH
ERROR MESSAGE: OUTPUT LIMIT EXCEEDED
;
.IOPC:
SOSGE CNT(XBH)
EXEC .IONB ;WRITE CURRENT BLOCK IF FULL
IDPB X0,BUP(XBH)
RETURN
.IONB:: PROC
SAVE <X0>
L1():! IF ;OUTFILE OR PRINTFILE
IFOFF ZFIOF(XWAC1)
GOTO FALSE
THEN LF X0,ZOFLIM(XWAC1)
edit(230)
LF X1,ZOFBLK(XWAC1) ;[230]
IF ;A LIMIT WAS SET FOR THIS FILE
JUMPE X0,FALSE
THEN ;Check against limit
IF ;NO OF BLOCKS WRITTEN EQUALS LIMIT
CAMGE X1,X0
GOTO FALSE
THEN ERRFILE
SETOFF ZFIOPN(XWAC1) ;FLAG FILE CLOSED [1C]
edit(41) ;[41]:
IOERC QDSCON,15,Output limit exceeded
SETON ZFIOPN(XWAC1) ;Flag file open if proceed [41]
ZF ZOFLIM(XWAC1) ;and set no limit [41]
FI FI
edit(230)
ADDI X1,1 ;[230] Always update write count
SF X1,ZOFBLK(XWAC1);[230]
PUTOUT
ELSE
IF ;DIRECTFILE
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN FINDBLOCK ;DO USETO UUO
PUTOUT ;AND WRITE BLOCK
READNEXTBLOCK
;NOW UPDATE BYTE COUNTER AND BYTE POINTER
LF X0,ZBHZBU(XBH)
ADDI X0,2
HRLI X0,(POINT 7,0)
LI X1,5*200
STD X0,BUP(XBH)
FI FI
SOS -1(XPDP) ;Special return!!
SOS -1(XPDP)
RETURN
EPROC
SUBTTL LOCAL SUBROUTINE: PUTOUT - OUTPUT NEXT BUFFER
COMMENT ;
PURPOSE: TO OUTPUT NEXT BUFFER
ENTRY: .IOPUT
INPUT ARGUMENT:
FILE REF IN XWAC1
BUFFER POINTER IN XBH FOR DIRECTFILE [5]
OUTPUT ARGUMENTS:-
NORMAT EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: PUTOUT
USED ROUTINE: ERRFILE
USED REGISTERS: X0, X1, XBH (=XWAC5) [24LE]
ERROR MESSAGE: TRANSFER FAILURE
;
.IOPUT:
IF ;DIRECTFILE
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN edit(5)
;[5] USE THE WORD COUNT ZDFWCT TO SET CURRENT WORD COUNT
; ZBUWCT AND UPDATE ZDFWCT
LF X1,ZDFWCT(XWAC1)
IF ;RECORD OVERLAPS BUFFER END
CAIG X1,200
GOTO FALSE
THEN ;Modify count
SUBI X1,200
SF X1,ZDFWCT(XWAC1)
LI X1,200
ELSE ;Nothing will be left to output
ZF ZDFWCT(XWAC1)
FI
SF X1,ZBUWCT(XBH)
LF X1,ZFIOBH(XWAC1);BUFFER HEADER ADDRESS
SETOFF ZDFMOD(XWAC1) ;NO MODIFICATION
LF X0,ZBHZBU(X1,-1)
ELSE
edit(24)
IF ;[24LE] XBH non-zero and byte pointer word address too large
JUMPE XBH,FALSE
L BUP(XBH)
TLNN 400000
GOTO FALSE
THEN ;Fix byte pointer
SUBI 1
HRLI 010700
ST BUP(XBH)
FI ;[24LE]
LI X0,0
FI
FILOP (OUT)
IF ;[24] Not OK
GOTO FALSE
THEN ;Error, flag file as closed, give message
SETOFF ZFIOPN(XWAC1)
ERRFILE
IOERR 3,Transfer failure
FI ;[24]
IF ;[24LE] XBH nonzero
JUMPE XBH,FALSE
L BUP(XBH) ;and byte pointer not
TLNE 400000 ;of the form 440700,,addr
GOTO FALSE
THEN ;Make it
HRLI (POINT 7,0)
ADDI 1 ;Must add one to word addr
ST BUP(XBH)
FI ;[24]
RETURN
SUBTTL LOCAL SUBROUTINE: READBLOCK
COMMENT ;
PURPOSE: TO READ NEXT BLOCK FROM AN INFILE OR DIRECTFILE.
IF IT IS A DIRECTFILE THEN THE EXTERNAL BLOCK
NUMBER IS CHECKED TO SEE IF IT IS A BLOCK IN THE FILE.
IF IT IS NOT THEN THE END OF FILE FLAG IS TURNED ON,
ELSE A USETI IS PERFORMED.
ENTRY: .IORB
INPUT ARGUMENT: XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: READBLOCK
USED ROUTINES: COMPBLOCK
IOUPD
ERRFILE
USED REGISTERS: X0, X1
ERROR MESSAGE: TRANSFER FAILURE
;
.IORB:: PROC
IF ;DIRECTFILE
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN LF X0,ZDFLOC(XWAC1)
JUMPLE X0,L1
;NOW CHECK IF BLOCK OUT OF RANGE
;THIS COULD BE THE CASE WHEN A
;DIRECTFILE IS PROCESSED SEQUENTIALLY
;AND NO LOCATE HAS BEEN DONE
LF X1,ZDFLIM(XWAC1)
IF ;LOCATION GREATER THAN LIMIT
CAMG X0,X1
GOTO FALSE
THEN ;TURN ON END-OF-FILE FLAGS
SETON ZIFEND(XWAC1)
SETON ZFIEND(XWAC1)
FI
IF ;SEQUENTIAL INPUT
IFOFF ZFINB(XWAC1)
GOTO FALSE
THEN ;BLOCKNO:=PREVIOUS BLOCKNO +1
LF X0,ZDFBLK(XWAC1)
ADDI X0,1
ELSE ;BLOCKNO:=COMPBLOCK
COMPBLOCK
FI
EXEC IOUPD ;PERFORM OUTPUT OF OLD BUFFER IF CHANGED
SF X0,ZDFBLK(XWAC1);UPDATE PREVIOUS BLOCKNO
FILOP (USETI)
LF X1,ZBHZBU(XBH);BUFFER ADDRESS
ELSE
LI X1,0
FI
FILOP (IN,X1)
edit(24)
IF ;[24] IN was not ok
GOTO FALSE
THEN
IF ;END OF FILE
IOCHECK
GOTO FALSE
L1():! THEN IF ;DIRECTFILE ;[1C]
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN ;CLEAR THE BUFFER
Q==OFFSET(ZBUDAT)
SETZM Q(XBH)
LI X1,Q+1(XBH)
HRLI X1,-1(X1)
BLT X1,Q+200-1(XBH)
edit(5) ;[5] ZF ZBUWCT(XBH) ;RESET WORD COUNT
IF ;OUTIMAGE WAS CALLED
IFOFF ZDFOUT(XWAC1)
GOTO FALSE
THEN LF X1,ZDFBLK(XWAC1)
FILOP (USETO,X1)
GOTO L9
FI
SETON ZIFEND(XWAC1)
FI
SETON ZFIEND(XWAC1)
GOTO L9
FI
;HERE WHEN TRANSFER FAILURE
SETOFF ZFIOPN(XWAC1) ;FLAG FILE CLOSED [1C]
ERRFILE
IOERR 3,Transfer failure
FI ;[24]
L9():! ;[24] Make sure byte pointer is of right form
L BUP(XBH)
IF ;Not of the form 440700,,addr
TLNE 400000
GOTO FALSE
THEN ;Make it
HRLI 440700
ADDI 1
ST BUP(XBH)
FI
RETURN
EPROC
SUBTTL [24] Local subroutine: READNEXTBLOCK
edit(24)
Comment;
Purpose: Reads next block in sequence from a directfile or infile
Function: Calls READBLOCK with the appropriate switch set on
Entry: IORN
;
IORN: SETON ZFINB(XWAC1)
READBLOCK
SETOFF ZFINB(XWAC1)
RETURN
SUBTTL LOCAL SUBROUTINE: IOUPD
COMMENT;
PURPOSE: TO OUTPUT THE LAST ACTIVE BUFFER IF OUTIMAGE WAS PERFORMED
ON (PART OF) IT. USED BY DIRECTFILE.
ENTRY: IOUPD
INPUT ARGUMENT: X0 CONTAINS CURRENT BLOCK NO
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC IOUPD
USED ROUTINES: FINDBLOCK
PUTOUT
USED REGISTER: X0
ERROR MESSAGES: -
;
IOUPD: PROC
SAVE X0
LF X0,ZDFBLK(XWAC1)
IF ;NO LONGER SAME BLOCK AND THE OLD ONE WAS CHANGED
CAMN X0,(XPDP)
GOTO FALSE
IFOFF ZDFMOD(XWAC1)
GOTO FALSE
THEN ;OUTPUT THE BLOCK BEFORE READING NEW BLOCK
FINDBLOCK
PUTOUT
FI
RETURN
EPROC
SUBTTL LOCAL SUBROUTINE: SEEKNAME
COMMENT ;
PURPOSE: TO SEE IF A LOGICAL FILE NAME EXISTS.
ENTRY: IOSEEK
INPUT ARGUMENTS:
XNAME CONTAINS THE SOUGHT LOGICAL NAME
X2 CONTAINS POINTER TO THE FILE OBJECT
OUTPUT ARGUMENT:
IMMEDIATE RETURN WHEN THE LOGICAL
NAME WAS IN USE ELSE SKIP RETURN.
ERROR MESSAGE ABOUT DOUBLE DEFINITION IS
PRINTED ONLY WHEN SEEKNAME IS CALLED
FROM SETUPFILE
NORMAL EXIT: SKIP RETURN
ERROR EXIT: IMMEDIATE RETURN
CALL FORMAT: SEEKNAME
USED ROUTINES: BREAKOUTIMAGE
OUTIMAGE
TYPENAME
USED REGISTERS: X0, X2
ERROR MESSAGE: LOGICAL NAME <...> ALREADY DEFINED
;
IOSEEK:
IF ;NAME IS NOT SAME OR NO FILE OBJECT
JUMPE X2,TRUE
CAMN XNAME,OFFSET(ZFINAM)(X2)
GOTO FALSE
THEN AOS (XPDP)
RETURN
FI
IFON YDSACT(XLOW) ;IF SIMDDT ACTIVE
RETURN
BREAKOUTIMAGE <Logical name: >
L X0,X6
TYPENAME
OUTIMAGE <already defined.>
RETURN
SUBTTL SIMULA PROCEDURE: .IOCL - CLOSE
COMMENT ;
PURPOSE: TO CLOSE A FILE. IF THE FILE IS CLOSED ALREADY A
RUN TIME ERROR OCCURS, EXCEPT FOR SYSOUT OR SYSIN.
IF OUTFILE OR PRINTFILE AND POS > 1 THE LAST IMAGE
IS OUTPUT BY A CALL TO OUTIMAGE (.IOOG).
THE CHANNEL IS RELEASED AND IOCHTB UPDATED.
THE BUFFER AREA IS RELEASED (FREEBUFF). THE OPEN
FLAG IS TURNED OFF.
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAT EXIT: RETURN
ERROR EXIT: IOERC [41]
CALL FORMAT: EXEC .IOCL
USED ROUTINES: ERRFILE
IOUPD
.IOOG (OUTIMAGE)
PUTCHAR
FREEBUFF
USED REGISTERS: X0, X1, XBH, XSW [61]
ERROR MESSAGES: FILE ALREADY CLOSED
CLOSE FAILURE
;
edit(267)
XCHN==XSW-1 ;[267] Channel no
XDVT==XCHN-1 ;[267] DEVTYP word
.IOCL: PROC
edit(61)
SAVE <X1,XBH,XSW,XCHN,XDVT> ;[267] [61]
LOWADR ;SET BASE REGISTER FOR STATIC AREA
CDEFER
L XSW,OFFSET(ZFIFND)(XWAC1) ;[61]
LF XCHN,ZFICHN(XWAC1) ;[267]
L XDVT,XCHN
DEVTYP XDVT,
SETZ XDVT, ;Error
IF ;[61] Special call
IFOFFA ZFIFND(XSW)
GOTO FALSE
THEN ;! Check channel first
JUMPE XDVT,L5 ;[267] Channel not active
GOTO L3
FI
IF ;FILE ALREADY CLOSED
IFONA ZFIOPN(XSW)
GOTO FALSE
THEN
CAME XWAC1,YSYSIN(XLOW)
CAMN XWAC1,YSYSOUT(XLOW)
GOTO L9
ERRFILE
edit(41) ;[41]:
IOERC QDSCON,5,File already closed
GOTO L8 ;Ignore CLOSE if user proceeds [41]
FI
IF ;THIS IS A FILE THAT CAN DO OUTPUT
IFOFFA ZFIOUT(XSW)
GOTO FALSE
THEN
edit(5)
edit(44)
;[5] [24] Set up buffer pointer in XBH.
;Needed in PUTCHAR, PUTOUT (via IOUPD).
LF XBH,ZFIOBH(XWAC1)
SUBI XBH,1
IF ;DIRECTFILE
IFOFFA ZFIDF(XSW)
GOTO FALSE
THEN
LI X0,-1 ;Fake a block number
EXEC IOUPD ;OUTPUT BLOCK IF MODIFIED
;Our friends in Sweden have illegally set the buffer headers for input
;and output to be the same. They may be able to get away with this on
;tops-10, but on Tops-20, it causes a CLOSE or RELEASE to write out
;the most recent input buffer, to a random location!! Hence we set
;the virgin bit in the buffer header, to prevent this output. This is
;explicitly illegal, but works with the emulator.
TOPS20,<
MOVSI X1,400000 ;SET VIRGIN BIT
IORM X1,OFFSET(ZBHUSE)(XBH)
> ;TOPS20
GOTO L5
ELSE
LF X0,ZFIICP(XWAC1) ;CURRENT POSITION
SKIPE X0 ;NOTHING IN IMAGE
EXEC .IOOG ;OUTIMAGE
FI
L XSW,OFFSET(ZFIFO)(XWAC1) ;[61]
IF ;Something was written
IFOFFA ZFIFO(XSW)
edit(112)
IFONA ZFILBO(XSW) ;[112] but last call was
GOTO FALSE ; not Breakoutimage
THEN ;APPEND LAST LINE FEED
LI X0,QLF
PUTCHAR
FI FI
edit(15)
L3():! IF ;[15] Controlling terminal
IFOFF ZFITA(XWAC1)
GOTO FALSE
THEN
LF X1,ZFICHN(XWAC1)
ADD X1,XLOW
IF ;[15] ZERO RH IF INFILE AND LH IF OUTFILE IN YIOCHT
IFONA ZFIIF(XSW)
GOTO FALSE
THEN
HRRZS YIOCHT(X1)
ELSE
HLLZS YIOCHT(X1)
edit(200)
IF ;[200] ENDFILE was encountered
IFOFF ZIFEND(XWAC1)
GOTO FALSE
THEN ;OPEN UUO to clear end-of-file condition
LI OFFSET(ZFISTI)(XWAC1)
HLL OFFSET(ZFICHN)(XWAC1)
TLO (OPEN)
XCT
HALT
FI ;[200]
FI
GOTO L6 ;SKIP CLOSE IF TTY FILE!
FI
edit(15)
IFON ZFITTY(XWAC1) ;[15] Do not CLOSE a tty chnl
GOTO L5 ;[15] (but RELEASE when thru)
edit(267)
LDB [POINT 6,XDVT,35] ;[267] TY.DEV field
CAIN .TYPTY
GOTO L5 ;[267] Do not CLOSE PTY channel (just release when thru)
edit(230)
SETZ X1, ;[230] Normal close option
IF ;OUTFILE ON DSK
TRNE XDVT,TY.DEV
GOTO FALSE ;NOT DSK
IFONA ZFIDE(XSW)
IFONA ZFIAPP(XSW) ;[230] But not APPEND mode
GOTO FALSE
THEN ;[230] Do not deallocate below SIZE argument
LF ,ZOFBLK(XWAC1)
LF X1,ZFIFIL(XWAC1)
IF ;Proper pointer
TLNE X1,-1
GOTO FALSE
THEN ;It should point to an extended lookup block
LF X1,ZXBLEN(X1)
IF ;Current size is greater than initial estimate
; or estimate is at most 5
CAIG X1,5
GOTO TRUE
CAIG (X1)
GOTO FALSE
THEN ;Release
SETZ X1,
ELSE ;Keep all blocks when closing
LI X1,4
FI
ELSE ;Release superfluous blocks
SETZ X1,
FI FI
IF ;[15]
IFONA ZFIIF(XSW)
GOTO FALSE
THEN ;OUTFILE OR DIRECTFILE
IFOFFA ZFIDF(XSW)
IORI X1,2 ;CLOSE ONLY OUTPUT SIDE IF NOT DIRECTFILE
ELSE ;INPUT
IORI X1,1 ;CLOSE ONLY INPUT SIDE
FI
L X0,X1 ;[15] END
FILOP (CLOSE)
IF IOCHECK
GOTO FALSE
THEN ;CLOSE OK!
L5():!
edit(61)
JUMPE XCHN,L9 ;[61]
edit(267)
L X1,XCHN ;[267]
ADD X1,XLOW
;ZERO RH FOR INFILE, LH FOR OUTFILE AND BOTH HALVES
; FOR DIRECTFILE IN YIOCHT
IFOFFA ZFIDF(XSW)
IFONA ZFIIF(XSW)
HLLZS YIOCHT(X1)
IFOFFA ZFIIF(XSW) ;[302]
HRRZS YIOCHT(X1)
IF ;[15] Channel not used any more
SKIPE YIOCHT(X1)
GOTO FALSE
THEN edit(267) ;[267]
FILOP (RELEASE)
FI
HRROS OFFSET(ZFICHN)(XWAC1) ;Flag file closed
L6():!
IF ;OUTFILE OR PRINTFILE
IFOFFA ZFIOF(XSW)
GOTO FALSE
THEN LF X1,ZFIOBH(XWAC1)
ZF ZOFBLK(XWAC1) ;RESET BLOCK COUNT
ELSE
LF X1,ZFIIBH(XWAC1)
FI
IF ;[61] Address ok and not controlling tty
SOJLE X1,FALSE
IFON ZFITA(XWAC1)
GOTO FALSE
edit(242)
THEN ;[242]
IFOFFA ZFIBNW(XSW)
FREEBUFF ;RELEASE BUFFER AREA
FI
L9():! SETZB X0,X1
STD X0,IMG(XWAC1) ;IMAGE:-NOTEXT
SETOFF ZFIOPN(XWAC1)
SETON ZIFEND(XWAC1) ;FLAG END OF FILE
edit(41)
L8():! ;[41]
CENABLE
RETURN
FI
;HERE IF CLOSE FAILURE
SETOFF ZFIOPN(XWAC1) ;FLAG FILE CLOSED [1C]
ERRFILE
edit(41) ;[41]:
IOERC QDSCON,6,CLOSE failure
GOTO L8 ;If user proceeds [41]
EPROC
SUBTTL SIMULA PROCEDURE: .IOEJ - EJECT
COMMENT ;
PURPOSE: TO UPDATE LINE (ZPFLIN) IN THE FILE OBJECT.
A RUN-TIME ERROR OCCURS IF THE ARGUMENT TO
EJECT IS NOT POSITIVE.
ENTRY: .IOEJ
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT
XWAC2 CONTAINS THE NEW VALUE OF LINE.
OUTPUT ARGUMENTS:
ZFIECT:=TRUE, ZPFLIN:=XWAC2
NORMAL EXIT: RETURN
ERROR EXIT: IOERC [41]
CALL FORMAT: EXEC .IOEJ
USED ROUTINE: ERRFILE
USED REGISTER: X0
ERROR MESSAGE: EJECT ARGUMENT OUT OF RANGE
;
.IOEJ: IF ;EJECT ARGUMENT OUT OF RANGE
JUMPG XWAC2,FALSE
THEN ;ERROR!
ERRFILE
edit(41) ;[41]:
IOERC QDSNIN,12,EJECT: argument out of range
NEWVALUE XWAC2 ;[41]
GOTO .IOEJ ;Try again with new argument [41]
FI
LF X0,ZPFLP(XWAC1) ;LINESPERPAGE
CAMGE X0,XWAC2
LI XWAC2,1 ;IF ARG > LINESPERPAGE THEN EJECT(1)
SF XWAC2,ZPFLIN(XWAC1)
SETON ZFIECT(XWAC1)
RETURN
SUBTTL SIMULA PROCEDURE: .IOIG - INIMAGE
edit(24)
COMMENT ; [24] Several changes, especially for directfile
PURPOSE: To copy data from the input buffer to the file Image.
As a side effect, the next buffer may be input
(more than one buffer for long images).
A run time error occurs if ENDFILE was caused
by the previous INIMAGE.
INIMAGE works slightly differently for INFILE and
DIRECTFILE.
INFILE:
Bytes are copied one at a time until a break character
(LF, VT, FF or altmode) is encountered or Image is full.
Nulls and CR characters are ignored. If the image becomes full
and the next significant character (not null or CR) is not a
break character, a run time error occurs. A break character
other than LF is transferred to Image as well as causing end
of transmission. The image is padded with blanks if necessary.
DIRECTFILE:
The imagesize given at file creation must match Image.Length
exactly, or an error message is given. Image.Length bytes
are always copied to Image, regardless of break characters.
A BLT instruction is used if possible (Image word oriented).
An empty image in the file (only zero words) is returned
as the end of file image ("/*" padded with trailing blanks).
ENDFILE is set if Loc<1 or Loc>max loc.
ENTRY: .IOIG
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT.
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: EXEC .IOIG
USED ROUTINES:
COMPBLOCK,COMPPOINTER,COMPSTART,GETCHR,READBLOCK,
ERRFILE, .IOLT (LOCATE)
USED REGISTERS:
XWAC2-XWAC3 TEXT REFERENCE
XCC LENGTH OF IMAGE
XBH POINTS TO BUFFER AREA
XIP BYTE POINTER TO IMAGE
XTAC END OF LINE FLAG
ERROR MESSAGES: EOF IN INIMAGE
EXTERNAL IMAGE TOO LONG
IMAGE TOO LARGE
;
.IOIG: PROC
SAVE <XWAC2,XWAC3,XCC,XBH,XIP,XL,XK>
LOWADR
CDEFER
IF ;END OF FILE
IFOFF ZIFEND(XWAC1)
GOTO FALSE
THEN ;ERROR
L1():! ERRFILE
IOERR 7,EOF in INIMAGE
FI
LI XTAC,0 ;XTAC IS USED AS END OF LINE FLAG
LD XWAC2,IMG(XWAC1)
LF XCC,ZTVLNG(,XWAC2) ;XCC=LENGTH OF IMAGE
LF XBH,ZFIIBH(XWAC1)
SUBI XBH,1 ;XBH=POINTER TO BUFFER AREA
IFOFF ZFIDF(XWAC1)
GOTO IOIGIF ;[24]
; GOTO IOIGDF ;[24]
IOIGDF: ;DIRECTFILE
;SEE IF THE WANTED BLOCK HAPPENS TO BE THE CURRENT
SETOFF ZDFOUT(XWAC1) ;Signal "INIMAGE called last" to READBLOCK
COMPBLOCK
STACK X1 ;Note!!! Used by COMPSTART as parameter in the stack!
LF X1,ZDFBLK(XWAC1)
CAIE X0,(X1) ;CURRENT BLOCK?
READBLOCK ;IF NOT READ THE WANTED BLOCK
COMPSTART
UNSTK X1
edit(24)
LFE ,ZDFLOC(XWAC1) ;[24]
LF X1,ZDFLIM(XWAC1) ;[24]
IF ;[24] Location <= 0 or > limit
JUMPLE TRUE
CAIG (X1)
GOTO FALSE
THEN ;Return EOF image
EXEC IOIGEF
GOTO L6
FI
LF XLI,ZDFIML(XWAC1) ;Required image length + 2
SUBI XLI,2
CAILE XLI,(XCC) ;Must fit in internal image
GOTO L5 ;Error
CAIE XLI,(XCC) ;[24] Must be identical size
GOTO [ZF ZFIICP(XWAC1)
ERRFILE
IOERR 11,Image too large
]
STACK [0] ;[24] Marker for null image
COMPPOINTER
IF ;Image is big enough to bother and starts on a word boundary
CAIG XCC,5 ;??
GOTO FALSE
JUMPN XTAC,FALSE
THEN ;Copy whole words
L XLB,XCC
L3():! SETZ XTAC, ;Use XTAC to flag buffer overlap
IF ;Current buffer does not have all of image
CAMGE XLB,CNT(XBH)
GOTO FALSE
THEN ;Excess length to XLI for next iteration
L XLB,CNT(XBH)
SUBI XLI,(XLB)
LI XTAC,1 ;Flag buffer overlap
FI
L XLB
IDIVI 5
ST XLB
IMUL [-5]
ADDM CNT(XBH)
L X1,BUP(XBH)
L (X1)
IF ;Zero word
JUMPN FALSE
THEN ;May be null record
L [ASCII/ /]
LOOP
ST (XIP)
ADDI X1,1
ADDI XIP,1
AS
SKIPN (X1)
SOJG XLB,TRUE
edit(33)
JUMPG XLB,L4 ;[33] Overlap
SA
FI
IF ;Still more to copy
JUMPLE XLB,FALSE ;[33]
THEN
L (X1)
IORM (XPDP)
MOVSI (X1)
HRRI (XIP)
ADDI X1,(XLB)
ADDI XIP,(XLB)
BLT -1(XIP)
FI
L4():! L BUP(XBH)
ST X1,BUP(XBH)
SUB X1
IMULI 5
ADD XCC,X0 ;Account for characters treated
LF X0,ZTVLNG(XWAC1,IMG)
IF ;Buffer overlap for this image
JUMPE XTAC,FALSE
THEN ;Read new block, then move the rest
READNEXTBLOCK
IFON ZFIEND(XWAC1)
GOTO L1
L XLB,XLI
JUMPG XLB,L3
FI FI
UNSTK XSAC
WHILE
SOJL XCC,FALSE
DO
GETCHD
IDPB XIP
OD
IF ;Null image read
JUMPN XSAC,FALSE
THEN ;Make EOF record
COMPPOINTER
LF XCC,ZTVLNG(,XWAC2)
CAILE XCC,2 ;Avoid padding once more
LI XCC,2
EXEC IOIGE1
FI
L6():! ;Locate(LOC+1)
LF XWAC2,ZDFLOC(XWAC1)
ADDI XWAC2,1
EXEC .IOLT
GOTO L9
IOIGIF: ;INFILE
COMPPOINTER
IFOFF ZFIEND(XWAC1)
GETCHR ;SKIP ANY RESIDUAL NULLS IN BUFFER
L X1,X0
edit(24)
IFON ZFIEND(XWAC1) ;[24] No more in the file?
GOTO L7 ;if not
edit(22) ;[22] Find out if file is line numbered
SETOFF SWLB35(XLOW)
L @BUP(XBH)
TRNE 1
SETON SWLB35(XLOW) ;Found a line number!
IDPB X1,XIP
WHILE ;NOT END OF IMAGE
SOJLE XCC,L8
JUMPL XTAC,FALSE ;And not end of line
DO
GETCHR
IDPB X0,XIP
OD
ST XIP,YDSIGS(XLOW) ;[22] Save XIP pointer, used by SIMDDT
EXEC IOIGSP ;Put spaces at the end of the image
L8():!
;NOW THE IMAGE IS FILLED WITH CHARACTERS AND
;POSSIBLY PADDED WITH BLANKS TO THE RIGHT
JUMPL XTAC,L9 ;[24] If end of line
GETCHR ;[24] Possible break character
JUMPL XTAC,L9 ;[24] If end of line
L5():! ZF ZFIICP(XWAC1) ;SETPOS(1) TO FACILITATE CLOSE VIA SIMDDT [1C]
ERRFILE
edit(41) ;[41] Make it possible to continue after this error
STACK XWAC1
LI XWAC1,IMG(XWAC1) ;XWAC1 pointer to IMAGE text var
IOERC QDSNIM,25,Too long input line
UNSTK XWAC1
GOTO L9
;[41] end
edit(24)
L7():! EXEC IOIGEF ;[24] Create end of file record
L9():! ;Common exit;
ZF ZFIICP(XWAC1) ;SETPOS(1)
CENABLE
RETURN
EPROC ;Inimage
;[24]
IOIGEF: ;Make EOF record in image
SETON ZIFEND(XWAC1)
IOIGE1: COMPPOINTER
LI X0,"/" ;SET END OF FILE RECORD
IDPB X0,XIP
SOJLE XCC,IOIGEN
LI X0,"*"
IDPB X0,XIP
SOJG XCC,IOIGSP ;[33]
IOIGEN: RETURN
IOIGSP: ;[24] Pad end of image with spaces
IF ;Enough characters left to bother
CAIGE XCC,2*5
GOTO FALSE
THEN ;Adjust to next word boundary, then move whole words
LI X0," "
Q==300000 ;One of these bits is on iff byte ptr
;is internal to a word
WHILE ;Byte pointer in the middle of a word
TLNN XIP,Q
GOTO FALSE
DO ;Insert space
IDPB X0,XIP
SUBI XCC,1
OD
NORMALIZE(XIP)
L [ASCII/ /]
ST (XIP)
L X0,XCC
IDIVI X0,5
ST X1,XCC
LI X1,1(XIP)
HRLI X1,(XIP)
ADD XIP,X0
BLT X1,-1(XIP)
FI
IF ;Any characters left to be blanked
JUMPE XCC,FALSE
THEN LI " "
LOOP IDPB XIP
AS SOJG XCC,TRUE
SA
FI
RETURN
SUBTTL SIMULA PROCEDURE: .IOLI - LASTITEM
COMMENT ;
PURPOSE: To find the next non-blank character on an input file.
If none is found, the value -1 is returned in the input
parameter register, otherwise the value is 0.
As a side effect, a number of spaces, tabs, and line feeds
are scanned past, and Image.Pos indicates the first non-blank
character.
ENTRY: .IOLI
INPUT ARGUMENT: XTAC points to the ac referencing the file object.
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC .IOLI
USED ROUTINES:
INIMAGE,INCHAR.
USED REGISTERS: X0, XWAC1-5
ERROR MESSAGES: -
;
.IOLI: PROC
LOWADR
CDEFER
STACK XTAC ;SAVE VALUE OF XTOP
SAVE <XWAC1,XWAC2,XWAC3,XWAC4,XWAC5>
L XWAC1,(XTAC) ;XWAC1 POINTS TO THE FILE OBJECT
L1():!
IF ;END OF FILE
IFOFF ZIFEND(XWAC1)
GOTO FALSE
THEN ;LASTITEM:=TRUE
SETO X0,
GOTO L9
FI
LOOP IF ;NOT MORE
LD XWAC2,IMG(XWAC1)
LF X0,ZTVLNG(,XWAC2)
CAILE X0,(XWAC3) ;IF POS > LENGTH
GOTO FALSE
THEN ;DO INIMAGE
EXEC .IOIG
GOTO L1
FI
L XWAC5,XWAC1
LI XTAC,XWAC5
EXEC .IOIC ;DO INCHAR
AS CAIE XWAC5," " ;IF SPACE
CAIN XWAC5,11 ;OR TAB
GOTO TRUE
SA
SOS OFFSET(ZFIICP)(XWAC1) ;SETPOS(POS-1)
SETZ X0, ;LASTITEM:=FALSE
L9():!
RESTORE
UNSTK XTAC
ST X0,(XTAC) ;SET LASTITEM
CENABLE
RET
EPROC
SUBTTL SIMULA PROCEDURE: .IOLP - LINESPERPAGE
COMMENT ;
PURPOSE: TO UPDATE LINESPERPAGE IN THE FILE OBJECT.
IF THE NEW VALUE IS ZERO THE
DEFAULT VALUE IN YIOLP IS USED,
IF IT IS NEGATIVE OR > 2**18-1
THEN 2**18-1 IS USED.
ENTRY: .IOLP
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT
XWAC2 CONTAINS THE NEW VALUE OF LINESPERPAGE
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC .IOLP
USED ROUTINES: -
ERROR MESSAGES: -
;
.IOLP:
IF ;Zero
JUMPN XWAC2,FALSE
THEN ;Set default
LOWADR
L XWAC2,YIOLP(XLOW)
FI
TLNE XWAC2,-1
LI XWAC2,377777 ;MAX VALUE
SF XWAC2,ZPFLP(XWAC1)
RETURN
SUBTTL SIMULA PROCEDURE: .IOLT - LOCATE
COMMENT ;
PURPOSE: TO UPDATE ZDFLOC IN THE FILE OBJECT.
ZDFEND AND ZFIEND ARE TURNED OFF IF THE ARGUMENT
IS IN RANGE.
ENTRY: .IOLT
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT
XWAC2 CONTAINS THE NEW VALUE OF LOCATION
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC .IOLT
USED ROUTINES: -
USED REGISTER: X0
ERROR MESSAGES: -
;
.IOLT:
edit(236)
IF ;[236] File is not open
IFOPEN XWAC1
GOTO FALSE
THEN ERRFILE
IOERR 0,File not open
FI
IF ;LOCATION IN RANGE, I.E.
;LOC > 0 AND LOC < ZDFLIM
JUMPLE XWAC2,TRUE
LF X0,ZDFLIM(XWAC1)
CAMGE X0,XWAC2
GOTO FALSE
THEN ;RESET END OF FILE
SETOFF ZDFEND(XWAC1)
SETOFF ZFIEND(XWAC1)
FI
SF XWAC2,ZDFLOC(XWAC1) ;ZDFLOC:=NEW LOCATION
edit(63)
SETOFF ZFIPGT(XWAC1) ;[63] No put or get on this buffer image yet
RETURN
SUBTTL SIMULA PROCEDURE: .IOOP - OPEN
COMMENT ;
PURPOSE: TO SET THE OPEN FLAG AND THE TEXT IMAGE REFERENCE.
IF THE FILE ALREADY IS OPEN A RUN TIME ERROR OCCURS.
IF THE FILE HAS BEEN CLOSED PREVIOUSLY (ZFICHN=-1)
THEN REOPEN IS PERFORMED. IF THE FILE IS OUTFILE OR
PRINTFILE AN INITIAL OUT UUO IS PERFORMED.
ENTRY: .IOOP
INPUT ARGUMENTS:
XWAC1 CONTAINS THE POINTER TO THE FILE OBJECT
XWAC2-XWAC3 CONTAIN IMAGE REFERENCE.
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERC [41]
CALL FORMAT: EXEC .IOOP
USED ROUTINES: ERRFILE
REOPEN
.IOLT (LOCATE)
.TXVA
PUTOUT
USED REGISTERS: X0, X1, XWAC1-2
ERROR MESSAGE: FILE ALREADY OPEN
;
.IOOP: PROC
LOWADR ;SET BASE REGISTER TO STATIC AREA
CDEFER
IF ;FILE IS OPEN
edit(236)
IFNOTOPEN(XWAC1) ;[236]
GOTO FALSE
THEN ;ERROR!
ERRFILE
edit(41) ;[41]:
IOERC QDSCON,4,File already open
GOTO L9 ;Ignore open if user proceeds! [41]
FI
STD XWAC2,IMG(XWAC1)
;SAVE IMAGE REFERENCE
IF ;FILE CLOSED BEFORE
HLRZ X1,OFFSET(ZFICHN)(XWAC1)
CAIE X1,-1
GOTO FALSE
THEN ;FILE MUST BE OPENED AGAIN
REOPEN
FI
SETOFF ZIFEND(XWAC1) ;FLAG NOT END OF FILE
SETON ZFIFO(XWAC1) ;FLAG FIRST OUTPUT
SETON ZFIOPN(XWAC1)
SETOFF ZFIEND(XWAC1)
IF ;DIRECTFILE
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN
SETOFF ZDFOUT(XWAC1)
SETOFF ZDFMOD(XWAC1)
ZF ZDFBLK(XWAC1)
edit(24)
;[24] Begin (code moved from .IOCF and modified)
LF X0,ZDFIML(XWAC1)
IF ;IMAGESIZE NOT DEFINED
JUMPN X0,FALSE
THEN ;Take length from image
LF X0,ZTVLNG(XWAC1,IMG)
ADDI X0,2
SF X0,ZDFIML(XWAC1) ;DEFAULT FOR IMAGE SIZE
FI
;X0 NOW CONTAINS ZFIIML
;COMPUTE NO OF WORDS IN THE LOGICAL RECORD
IDIVI X0,5 ;NUMBER OF WORDS
CAIE X1,0
ADDI X0,1 ;ADJUST IF NON-ZERO REMAINDER
IMULI X0,5 ;X0=REAL NO OF BYTES IN RECORD
;INCLUDED POSSIBLY PADDED NULLS
LF X1,ZFIFIL(XWAC1)
;COMPUTE MAX RECORD NO
LF X1,ZXBLNG(X1) ;FILE LENGTH IN WORDS
IMULI X1,5 ;FILE LENGTH IN BYTES
IDIV X1,X0
SF X1,ZDFLIM(XWAC1) ;AND STORE IN LIMIT
;[24] End of code taken from .IOCF
LI XWAC2,1
EXEC .IOLT ;LOCATE(1)
edit(5)
ZF ZDFWCT(XWAC1) ;[5] INITIAL WORD COUNT=0
GOTO L1
FI
IF ;OUTFILE, PRINTFILE OR DIRECTFILE
IFOFF ZFIOF(XWAC1)
GOTO FALSE
THEN
edit(252)
L1():! LD XWAC2,IMG(XWAC1) ;[252]
ZF ZFIICP(XWAC1) ;POS:=1
IF ;SIMDDT INACTIVE
IFON YDSACT(XLOW)
GOTO FALSE
THEN SETZB XWAC4,XWAC5 ;IMAGE:=NOTEXT
LI XTAC,XWAC2
EXEC .TXVA
FI
IF ;NOT TTY
IFON ZFITTY(XWAC1)
GOTO FALSE
THEN
IF ;[24LE] Outfile or Printfile
IFOFF ZFIOF(XWAC1)
GOTO FALSE
THEN ;Initial output
SETZ XBH,
PUTOUT
FI ;[24LE]
FI
ELSE
HLRS OFFSET(ZFIICP)(XWAC1) ;POS:=LENGTH+1
FI
IF ;PRINTFILE
IFOFF ZFIPF(XWAC1)
GOTO FALSE
THEN ;INITIALIZE PRINTFILE CHARACTERISTICS
IF edit(266) ;[266] Sysout on TTY
IFON ZFITTY(XWAC1)
CAME XWAC1,YSYSOUT(XLOW)
GOTO FALSE
THEN ;Linesperpage(-1)
LI X0,-1
ELSE ;Standard value
L X0,YIOLP(XLOW)
FI
SF X0,ZPFLP(XWAC1) ;LINESPERPAGE := DEFAULT
LI X0,1
SF X0,ZPFSP(XWAC1) ;SPACING := 1
SF X0,ZPFLIN(XWAC1);NEXT LINE := 1
ZF ZPFLL(XWAC1) ;LAST LINE := 0
FI
L9():! ;[41]
CENABLE
RETURN
EPROC ;IOOP
SUBTTL SIMULA PROCEDURE: .IOOG AND .IOBO - OUTIMAGE AND BREAKOUTIMAGE
edit(24)
COMMENT ; [24] Code reorganized and changed
PURPOSE: TO MOVE THE INTERNAL IMAGE TO THE OUTPUT BUFFER.
ONE OR MORE OUT UUO:S MAY OCCUR AS A SIDE EFFECT.
IF IT IS A DIRECTFILE THEN THE EXTERNAL BLOCK
NUMBER IS COMPUTED (COMPBLOCK) AND IF THIS IS
NOT THE SAME AS THE BLOCK CURRENTLY IN CORE
THEN THE WANTED BLOCK IS READ TO CORE (READBLOCK).
THE CHARACTERS ARE MOVED FROM THE INTERNAL IMAGE
TO THE BUFFER.
FOR AN OUTFILE OR PRINTFILE -
TO SAVE SPACE AND TIME, ONLY IMAGE.STRIP IS MOVED, UNLESS
BREAKOUTIMAGE WAS CALLED AND POS GT IMAGE.STRIP.LENGTH,
IN WHICH CASE POS-1 IS SUBSTITUTED FOR THE LENGTH.
ENTRIES: .IOBO (BREAKOUTIMAGE)
.IOOG (OUTIMAGE)
INPUT ARGUMENTS:
XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMATS: EXEC .IOBO (BREAKOUTIMAGE)
EXEC .IOOG (OUTIMAGE)
USED ROUTINES:
COMPBLOCK,COMPPOINTER,COMPSTART,READBLOCK,PUTCHAR,
IONB, .IOLT (LOCATE)
.TXST TO PERFORM IMAGE.STRIP
USED REGISTERS:
XWAC2-XWAC3 TEXT REFERENCE
XCC LENGTH OF IMAGE
XBH POINTS TO BUFFER AREA
XIP BYTE POINTER TO IMAGE
XTAC ARGUMENT TO .TXST
XSAC BREAKOUTIMAGE FLAG
XL POINTER TO IMAGE
XK CONTAINS BLANK CHARACTER
ERROR MESSAGES: FILE NOT OPEN
IMAGE TOO LARGE
;
.IOBO: ;BREAKOUTIMAGE ENTRY
PROC
TDZA XSAC,XSAC ;FLAG BREAKOUTIMAGE AND SKIP
.IOOG: ;OUTIMAGE ENTRY
LI XSAC,QCR ;FLAG OUTIMAGE
LOWADR
CDEFER
SAVE <XWAC2,XWAC3,XCC,XBH,XIP,XK,XL>
IF ;FILE IS CLOSED
edit(236)
IFOPEN(XWAC1) ;[236]
GOTO FALSE
THEN ;ERROR!
ERRFILE
IOERR 0,File not open
FI
LD XWAC2,IMG(XWAC1)
edit(24)
LF XCC,ZTVLNG(,XWAC2) ;[24] Image.Length
LF XBH,ZFIOBH(XWAC1)
SUBI XBH,1 ;XBH=POINTER TO BUFFER AREA
IF ;DIRECTFILE
IFOFF ZFIDF(XWAC1)
GOTO FALSE
THEN
IF ;[24] File is read only
IFOFF ZFIRON(XWAC1)
GOTO FALSE
THEN ERRFILE
IOERR 17,File is read only
FI ;[24]
LF XLI,ZDFIML(XWAC1)
SUBI XLI,2(XCC)
IF ;IMAGE LENGTH INCORRECT
JUMPE XLI,FALSE
THEN ;ERROR!!
ERRFILE
IF ;[24] Image too big
JUMPG XLI,FALSE
THEN
IOERR 11,Image too large
ELSE
IOERR 10,External image too long
FI FI
edit(41)
L1():! ;[41]
LFE X0,ZDFLOC(XWAC1)
IF ;LOC NON-POSITIVE
JUMPG X0,FALSE
THEN ;ERROR!
ERRFILE
;[41]:
IOERC QDSNIN,16,LOCATION not positive
NEWVALUE X0 ;[41]
SF X0,ZDFLOC(XWAC1) ;[41]
GOTO L1 ;[41]
FI
SETON ZDFOUT(XWAC1) ;FLAG OUTIMAGE CALL FOR READBLOCK
COMPBLOCK
STACK X1
LF X1,ZDFBLK(XWAC1)
CAIE (X1)
READBLOCK ;IF BLOCK NOT IN BUFFER
COMPSTART
LF X0,ZDFIML(XWAC1);COMPUTE LAST WORD NO OF IMAGE
ADDI X0,4
IDIVI X0,5
ADD X0,(XPDP)
edit(5)
;[5] USE ZDFWCT INSTEAD OF ZBUWCT
LF X1,ZDFWCT(XWAC1)
IF ;GREATER THAN CURRENT WORD COUNT
CAIGE X0,(X1)
GOTO FALSE
THEN ;UPDATE WORD COUNT FOR BUFFER
;[5] USE ZDFWCT INSTEAD OF ZBUWCT
; AND REMOVE TEST ON BUFFER LIMIT
; (NOW PERFORMED IN PUTOUT)
SF X0,ZDFWCT(XWAC1)
FI
UNSTK X1
edit(24)
EXEC IOOG.M ;[24] Copy to buffer
;Append CR-LF and nulls if required, mark this block as modified
LI X0,QCR
PUTCHAR ;APPEND CR
LI X0,QLF
PUTCHAR ;APPEND LF
EXEC IOOGWB ;[24] Insert nulls to next word boundary
SETON ZDFMOD(XWAC1)
LF XWAC2,ZDFLOC(XWAC1)
LF X1,ZDFLIM(XWAC1)
CAMLE XWAC2,X1 ;IF LOC > LIMIT
SF XWAC2,ZDFLIM(XWAC1) ;THEN LIMIT:=LOC
ADDI XWAC2,1
EXEC .IOLT ;LOCATE(LOC+1)
ELSE ;Outfile (Printfile)
STACK XSAC ;SAVE FLAG
LI XTAC,XWAC2
EXEC .TXST ;PERFORM IMAGE.STRIP
LF XCC,ZTVLNG(,XWAC2) ;XCC=IMAGE.STRIP.LENGTH
IF ;BREAKOUTIMAGE
SKIPE (XPDP)
GOTO FALSE
THEN ;Use the larger of Image.Pos-1,
; Image.Strip.Length (XCC)
LF X0,ZFIICP(XWAC1)
CAMLE X0,XCC
L XCC,X0 ;IF POS-1 LARGER
IF ;STRIP GAVE NOTEXT
JUMPN XWAC2,FALSE
THEN ;RESTORE OFFSET AND OBJECT ADDRESS FROM IMAGE
WLF XWAC2,ZFIIMG(XWAC1)
FI FI
IF ;NOT PRINTFILE
IFON ZFIPF(XWAC1)
GOTO FALSE
THEN LI XK,1
IF ;FIRST OUTPUT
IFOFF ZFIFO(XWAC1)
GOTO FALSE
THEN ;NO LINE FEED!
SETOFF ZFIFO(XWAC1)
LI XK,0
FI
ELSE ;POSITION THIS LINE ON THE PAGE
;REGISTER NAMES:
XNL=XK ;NEXT LINE NO
XLL=XL ;LAST LINE NO
XLPP=XTAC ;LINESPERPAGE
edit(16)
XLF=XWAC2 ;LINE FEED OR NULL (IF TTY) ;[16]
COMMENT ;
THE FOLLOWING CASES MAY OCCUR:
1. THIS IS THE FIRST IMAGE (XLL=0).
OUTPUT FORM FEED AND (XNL) -1 LINE FEED.
2. XNL=XLL
A) SPACING(0).
APPEND NO LINE FEED.
B) EJECT(LINE-1).
APPEND LINE FEED, FORM FEED.
AND (XNL) -1 LINE FEEDS.
3. XLL < XNL < XLPP, I.E. NEXT LINE SHOULD
BE PRINTED ON SAME PAGE.
APPEND (XNL-XLL) LINE FEEDS.
4. XLL > XNL, I.E. NEXT IMAGE SHOULD BE
PRINTED ON LINE XNL OF NEXT PAGE.
OUTPUT LINE FEED, FORM FEED.
AND (XNL) -1 LINE FEEDS.
(SAME AS 2B).
5. XNL > XLPP
A) EJECT HAS BEEN DONE.
SAME AS 2B.
B) EJECT HAS NOT BEEN DONE, I.E. NEXT
LINE SHOULD BE PRINTED ON TOP OF NEXT PAGE.
OUTPUT LINE FEED, FORM FEED.
AND SET LINE TO 1.
;
DEFINE PUTFF=<
L X0,XLF ;[16]
PUTCHAR ;[16]
LI X0,QFF
PUTCHAR
>
LI XLF,QLF ;[16] SET XLF TO QLF
IFON ZFITTY(XWAC1)
SETZ XLF, ; Change to null for tty
SETOFF ZFIFO(XWAC1)
LF XLPP,ZPFLP(XWAC1)
LF XLL,ZPFLL(XWAC1)
LF XNL,ZPFLIN(XWAC1)
IF ;THIS IS THE FIRST IMAGE (CASE 1)
JUMPN XLL,FALSE
THEN ;APPEND FF ONLY
IF ;NOT TTY
JUMPE XLF,FALSE
THEN LI X0,QFF ;[16]
PUTCHAR ;[16]
SUBI XK,1 ;[16]
FI
ELSE
IF ;SAME LINE (CASE 2)
CAME XLL,XNL
GOTO FALSE
THEN IF ;SPACING(0) (CASE 2A)
IFON ZFIECT(XWAC1)
GOTO FALSE
THEN ;NO LINE FEEDS AT ALL
LI XK,0
ELSE ;MUST BE EJECT TO SAME LINE (CASE 2B)
PUTFF
SKIPE XLF ;[16]
SUBI XK,1 ;[16]
FI
ELSE
IF ;NEXT LINE < LAST LINE (CASE 4)
CAML XNL,XLL
GOTO FALSE
THEN ;OUTPUT FF
PUTFF
SKIPE XLF ;[16]
SUBI XK,1 ;[16]
ELSE
IF ;NEXT LINE > LINESPERPAGE (CASE 5)
CAMG XNL,XLPP
GOTO FALSE
THEN PUTFF
IF ;EJECT HAS NOT BEEN DONE
IFON ZFIECT(XWAC1)
GOTO FALSE
THEN ;CASE 5B
LI XK,0
LI X0,1
SF X0,ZPFLIN(XWAC1) ;LINE:=1
FI
ELSE ;MUST BE CASE 3!
SUB XK,XLL ;NO OF LINE FEEDS=NEXT LINE - LAST LINE
;[1C] TAKE CARE OF EJECT(LINE) CASE
IF ;NEXT LINE AFTER EJECT
;I.E. EJECT(LINE) WAS DONE
IFON ZFIECT(XWAC1)
CAIE XK,1
GOTO FALSE
THEN ;NEXT LINE ON NEW PAGE!
PUTFF
LF XK,ZPFLIN(XWAC1)
SKIPE XLF ;[16]
SUBI XK,1 ;[16]
FI
;END OF [1C]
FI FI FI FI FI
;XK NOW CONTAINS NO OF LINE FEEDS TO BE APPENDED
;ADJUST XK FOR THE CASE OF TTY
edit(44)
edit(112)
;or if LAST CALL WAS BREAKOUTIMAGE [44] [112]
IF ;[44] [112] Last call was outimage
IFON ZFILBO(XWAC1)
GOTO TRUE
IFOFF ZFITTY(XWAC1) ;or TTY output
GOTO FALSE
THEN ;Take away one LF
SUBI XK,1
FI ;[44] [112]
WHILE ;MORE LINES
SOJL XK,FALSE
DO ;APPEND LINE FEED
LI X0,QLF
PUTCHAR
OD
edit(24)
IFON ZFIWDB(XWAC1) ;[24] Word alignment if specified
EXEC IOOGWB ;[24]
EXEC IOOG.M ;[24] Copy to buffer
UNSTK XK
IF ;OUTIMAGE
JUMPE XK,FALSE
THEN ;APPEND CR
edit(44)
SETOFF ZFILBO(XWAC1) ;[44] flag last call as OUTIMAGE
LI X0,QCR
PUTCHAR ;CR
edit(63)
SETOFF ZFIPGT(XWAC1) ;[63] Tell put Outimage called
ELSE
SETON ZFILBO(XWAC1) ;[44] flag last call as BREAKOUTIMAGE
FI
IF ;TTY
IFOFF ZFITTY(XWAC1)
GOTO FALSE
THEN ;OUTPUT BUFFER IMMEDIATELY
IF ;NOT BREAKOUTIMAGE OR SPACING(0)
JUMPE XK,FALSE
edit(16)
LF X0,ZPFSP(XWAC1) ;[16]
JUMPE X0,FALSE ;[16] SPACING(0)
THEN LI X0,QLF
PUTCHAR ;BUT FIRST APPEND LINE FEED
FI
PUTOUT
FI
IF ;PRINTFILE
IFOFF ZFIPF(XWAC1)
GOTO FALSE
THEN SETOFF ZFIECT(XWAC1) ;FLAG NO EJECT
LF X0,ZPFLIN(XWAC1)
SF X0,ZPFLL(XWAC1) ;UPDATE LAST PRINTED LINE
LF XK,ZPFSP(XWAC1)
ADD X0,XK ;ADD SPACING AMOUNT
SF X0,ZPFLIN(XWAC1);UPDATE NEXT LINE
FI FI
ZF ZFIICP(XWAC1) ;Setpos(1)
CENABLE
RETURN
EPROC
;END OF OUTIMAGE
SUBTTL IOOG.M [24] Move image to output buffer
edit(24)
IOOG.M: PROC ;[24] MOVE THE IMAGE TO THE BUFFER
L XWAC2,IMG(XWAC1) ;Load image reference
COMPPOINTER ;Compute XIP, XTAC=0 if word-aligned image
IF ;Word-aligned image
JUMPN XTAC,FALSE
HLLZ BUP(XBH) ;AND image in buffer on word boundary
TLNN 300000
CAIG XCC,5 ;?? AND image big enough to bother
GOTO FALSE
THEN ;Use BLT for most of the image
L XLI,XCC
L XLB,XLI
IF ;Line numbers specified
IFOFF ZFINUM(XWAC1)
GOTO FALSE
THEN ;Turn on last bit of first word of image
LI 1
IORM (XIP)
FI
L1():! SKIPG CNT(XBH)
EXEC .IONB
SETZ XTAC, ;Use XTAC as truncation flag
IF ;Buffer cannot hold all of image
CAMGE XLB,CNT(XBH)
GOTO FALSE
THEN ;Move the part that fits, compute length of rest
L XLB,CNT(XBH)
SUBI XLI,(XLB)
LI XTAC,1
FI
L XLB
IDIVI 5 ;Convert to no of words
ST XLB
IMUL [-5] ;Negated no of characters corresp to full words
ADDM CNT(XBH)
ADD XCC,X0
;Make BLT word in X0
L X1,BUP(XBH)
NORMALIZE(X1)
LI (X1)
HRLI (XIP)
ADDI X1,(XLB)
ST X1,BUP(XBH)
BLT -1(X1) ;Move the info
;Blank the copied part of image
L [ASCII/ /]
ST (XIP)
LI 1(XIP)
HRLI (XIP)
ADDI XIP,(XLB)
CAILE XLB,1
BLT -1(XIP)
IF ;Image did not fit into this buffer
JUMPE XTAC,FALSE
THEN ;handle the rest in next buffer
SKIPG CNT(XBH) ;[24LE] For return from .IONB
EXEC .IONB
L XLB,XLI
CAIL XLB,5 ;[24R]
GOTO L1 ;[24R]
FI FI
;Handle tail of image character by character
LI XK," "
IF ;IMAGE NOT EMPTY
JUMPLE XCC,FALSE
THEN LOOP ;MOVE CHARACTERS FROM IMAGE TO BUFFER
ILDB X0,XIP ;GET NEXT BYTE
DPB XK,XIP ;AND BLANK IT IN IMAGE
SOSGE CNT(XBH)
EXEC .IONB ;WRITE CURRENT BLOCK IF FULL
IDPB X0,BUP(XBH)
AS SOJG XCC,TRUE
SA
FI
RETURN
EPROC
IOOGWB: ;[24] Append nulls till next word boundary
SETZ
EXCH X1,BUP(XBH)
WHILE ;Not on word boundary
TLNN X1,300000 ;These bits off iff full word byte ptr
GOTO FALSE
DO
IDPB X1
SOS CNT(XBH)
OD
NORMALIZE(X1)
EXCH X1,BUP(XBH)
RETURN
SUBTTL SIMULA PROCEDURE: .IOSP - SPACING
COMMENT ;
PURPOSE: TO UPDATE SPACING (ZPFSP) IN THE FILE OBJECT.
A RUN-TIME ERROR OCCURS IF THE NEW VALUE OF
SPACING IS NEGATIVE OR GREATER THAN LINESPERPAGE.
ENTRY: .IOSP
INPUT ARGUMENTS:
XWAC1 POINTS TO THE FILE OBJECT
XWAC2 CONTAINS THE NEW VALUE OF SPACING.
OUTPUT ARGUMENTS:-
NORMAL EXIT: RETURN
ERROR EXIT: IOERR
CALL FORMAT: EXEC .IOSP
USED ROUTINE: ERRFILE
USED REGISTER: X0
ERROR MESSAGE: SPACING ARGUMENT OUT OF RANGE
;
.IOSP:
IF ;SPACING ARGUMENT OUT OF RANGE
JUMPL XWAC2,TRUE
LF X0,ZPFLP(XWAC1) ;LINESPERPAGE
CAML X0,XWAC2
GOTO FALSE
THEN ;ERROR!
ERRFILE
edit(41) ;[41]:
IOERC QDSNIN,13,SPACING: argument out of range
NEWVALUE XWAC2 ;[41]
GOTO .IOSP ;Try again [41]
FI
SF XWAC2,ZPFSP(XWAC1) ;UPDATE SPACING
RETURN
SUBTTL IOFI ENTRIES
edit(61)
.IOASL==1 ;[61] ASCII line mode is standard
;DECLARATION ENTRY FOR FILE:
IOFI%D::
edit(105)
LF ,ZFIDMO(XCB) ;[105] Keep data mode if set already
IF ;[105] Zero
JUMPN FALSE
THEN ;ASCII line mode
LI .IOASL ;[61]
SF ,ZFIDMO(XCB)
FI ;[105]
LI XSAC,0 ;LEVEL 0
JSP CPCD
;STATEMENT ENTRY FOR FILE:
IOFI%S::
LI XSAC,0
JSP CPCI
;INNER ENTRY FOR FILE:
IOFI%I::
JSP CPE0
;MAP FOR FILE
IOFI%M=:0
;SYMBOL TABLE FOR FILE
DZSMCL .FILE.,IOFI
edit(22)
;[22] ADD A NULL SECOND PARAMETER TO ALL DZSD
DZSD NAME,,QTEXT,QVALUE,,OFFSET(ZFISPC) ;[1C]
DZSD IMAGE,,QTEXT,QVALUE,,IMG
DZSD OPEN,,QNOTYPE,,QPROCEDURE,0
DZSD CLOSE,,QNOTYPE,,QPROCEDURE,0
DZSD MORE,,QBOOLEAN,,QPROCEDURE,0
DZSD SETPOS,,QNOTYPE,,QPROCEDURE,0
DZSD POS,,QINTEGER,,QPROCEDURE,0
DZSD LENGTH,,QINTEGER,,QPROCEDURE,0
Z
SUBTTL IOIN ENTRIES
;DECLARATION ENTRY FOR INFILE:
IOIN%D::
edit(61)
IFN <OFFSET(ZFIIN)-OFFSET(ZFIIF)>,<CFAIL Wrong offsets IOIN%D> ;[61]
L [1B<%ZFIIN>+1B<%ZFIIF>]
IORM OFFSET(ZFIIN)(XCB)
LI XSAC,1 ;LEVEL 1
JSP CPCD
;STATEMENT ENTRY FOR INFILE:
IOIN%S::
IOCA:
ZEROSW
SETUPFILE
LI XSAC,1
JSP CPCI
;INNER ENTRY FOR INFILE:
IOIN%I=:IOFI%I
;MAP FOR INFILE
IOIN%M=:0
;SYMBOL TABLE FOR INFILE
DZSMCL INFILE,IOIN
DZSD ENDFILE,,QBOOLEAN,,,OFFSET(ZIFEND)
DZSD LASTITEM,,QBOOLEAN,,QPROCEDURE,0
DZSD INCHAR,,QCHARACTER,,QPROCEDURE,0
DZSD ININT,,QINTEGER,,QPROCEDURE,0
DZSD INIMAGE,,QNOTYPE,,QPROCEDURE,0
DZSD INREAL,,QLREAL,,QPROCEDURE,0
DZSD INTEXT,,QTEXT,,QPROCEDURE,0
DZSD INFRAC,,QINTEGER,,QPROCEDURE,0
Z
SUBTTL IOOU ENTRIES
;DECLARATION ENTRY FOR OUTFILE:
IOOU%D::
edit(61)
IFN <OFFSET(ZFIOUT)-OFFSET(ZFIOF)>,<CFAIL Wrong offsets IOOU%D> ;[61]
L [1B<%ZFIOUT>+1B<%ZFIOF>]
IORM OFFSET(ZFIOUT)(XCB)
LI XSAC,1
JSP CPCD
;STATEMENT ENTRY FOR OUTFILE:
IOOU%S=:IOIN%S ;[61]
;INNER ENTRY FOR OUTFILE:
IOOU%I=:IOFI%I
;MAP FOR OUTFILE
IOOU%M=:0
;SYMBOL TABLE FOR OUTFILE
DZSMCL OUTFILE,IOOU
DZSD OUTCHAR,,QNOTYPE,,QPROCEDURE,0
DZSD OUTINT,,QNOTYPE,,QPROCEDURE,0
DZSD OUTIMAGE,,QNOTYPE,,QPROCEDURE,0
DZSD BREAKOUTIMAG,,QNOTYPE,,QPROCEDURE,0
DZSD OUTREAL,,QNOTYPE,,QPROCEDURE,0
DZSD OUTTEXT,,QNOTYPE,,QPROCEDURE,0
DZSD OUTFIX,,QNOTYPE,,QPROCEDURE,0
DZSD OUTFRAC,,QNOTYPE,,QPROCEDURE,0
Z
SUBTTL IOPF ENTRIES
;DECLARATION ENTRY FOR PRINTFILE:
IOPF%D::
SETON ZFIPF(XCB)
LI XSAC,2
JSP CPCD
;STATEMENT ENTRY FOR PRINTFILE:
IOPF%S::
LI XSAC,2
JSP CPCI
;INNER ENTRY FOR PRINTFILE:
IOPF%I=:IOFI%I
;MAP FOR PRINTFILE
IOPF%M=:0
;SYMBOL TABLE FOR PRINTFILE
DZSMCL PRINTFILE,IOPF
DZSD LINE,,QINTEGER,,QPROCEDURE,0
DZSD LINESPERPAGE,,QNOTYPE,,QPROCEDURE,0
DZSD SPACING,,QNOTYPE,,QPROCEDURE,0
DZSD EJECT,,QNOTYPE,,QPROCEDURE,0
Z
SUBTTL IODF ENTRIES
;DECLARATION ENTRY FOR DIRECTFILE:
IODF%D::
edit(61)
L [1B<%ZFIDF>+1B<%ZFIIN>+1B<%ZFIOUT>+1B<%ZFIWDB>] ;[61]
IORM OFFSET(ZFIDF)(XCB)
SETON ZFIUWC(XCB) ;[61] Use word count
LI XSAC,1
JSP CPCD
;STATEMENT ENTRY FOR DIRECTFILE:
IODF%S=:IOIN%S ;[61]
;INNER ENTRY FOR DIRECTFILE:
IODF%I=:IOFI%I
;MAP FOR DIRECTFILE
IODF%M=:0
;SYMBOL TABLE FOR DIRECTFILE
DZSMCL DIRECTFILE,IODF
DZSD LOCATE,,QNOTYPE,,QPROCEDURE,0
DZSD LOCATION,,QINTEGER,,QPROCEDURE,0
DZSD ENDFILE,,QBOOLEAN,,,OFFSET(ZDFEND)
DZSD LASTITEM,,QBOOLEAN,,QPROCEDURE,0
DZSD INCHAR,,QCHARACTER,,QPROCEDURE,0
DZSD ININT,,QINTEGER,,QPROCEDURE,0
DZSD INIMAGE,,QNOTYPE,,QPROCEDURE,0
DZSD INREAL,,QLREAL,,QPROCEDURE,0
DZSD INTEXT,,QTEXT,,QPROCEDURE,0
DZSD INFRAC,,QINTEGER,,QPROCEDURE,0
DZSD OUTCHAR,,QNOTYPE,,QPROCEDURE,0
DZSD OUTINT,,QNOTYPE,,QPROCEDURE,0
DZSD OUTIMAGE,,QNOTYPE,,QPROCEDURE,0
DZSD OUTREAL,,QNOTYPE,,QPROCEDURE,0
DZSD OUTTEXT,,QNOTYPE,,QPROCEDURE,0
DZSD OUTFRAC,,QNOTYPE,,QPROCEDURE,0
Z
SUBTTL LITERALS
LIT
END