Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/15/o3.mac
There are 2 other files named o3.mac in the archive. Click here to see a list.
;<ENDERIN>O3.MAC.18, 10-Jan-77 14:07:06, Edit by ENDERIN
SEARCH SIMMAC,SIMMC3 ;[104]
SALL
CTITLE O3
SUBTTL Pass 3 I/O
;AUTHOR: ELISABETH $LUND
; UPDATED AT ACADIA UNIVERSITY FOR KA10
;VERSION: 4 [2,10,12,15,15R,20,24,104,144,162,172,222,225]
;PURPOSE: HANDLE I/O TRANSMISSIONS PASS 3
;CONTENTS:
INTERN O3ATR,O3ATRC,O3RA,O3WATR,O3RS,O3WS,O3ERR,O3RI,O3RIB
INTERN O3RSC,O3RZ,O3WIB,O3SCLS,O3LS3
MACINIT
P3INIT ;[104]
TWOSEG
RELOC 400000
QOHATR==7 ;[12] Overhead for ATR file (before ATR info)
QOHATE==6 ;[12] Extra space after ATR info (for end block)
EXTERN IDLA ;[12] ATR info starts here
EXTERN E3DB ;CONVERSION DEC ASCII-BIN
EXTERN E3LICF ;UPDATE PAGE NUMBER FOR FORM FEED
EXTERN T3A ;[10] DELETE nnnATR.TMP
EXTERN T3T3 ;TERMINATION ROUTINE
EXTERN .JBREL
EXTERN Y3ERRL ;LOOKUP ARG SIMERR.ERR
EXTERN YELATR ;LOOKUP ARG ATR
EXTERN YELREL ;LOOKUP ARG REL [144]
EXTERN YBHATR ;BUFFER HEADER ATR
EXTERN YELEXT ;LOOKUP ARG .ATR
EXTERN YBHEXT ;BUFFER HEADER .ATR
EXTERN YELZSE ;LOOKUP ARGUMENT ZSE
EXTERN YBHZSE ;BUFFERHEADER ZSE.TMP
EXTERN YBHSRC ;BUFFERHEADER INFILE.SIM
EXTERN YBHLS3 ;BUFFERHEADER LS3.TMP
EXTERN YELLS1 ;LOOKUP ARGUMENT LS1.TMP
EXTERN YBHLS1 ;BUFFERHEADER LS1.TMP
EXTERN YBHREL ;BUFFER HEADER REL FILE
EXTERN YEXTS ;LOOKUP ARGS FOR STANDARD FILES
EXTERN Y3BUFS ;USED WHEN READING ERROR TABLES INTO CORE
EXTERN Y3INBU ;COMMAND LIST UNBUFFERED INPUT ERROR TABLES
EXTERN Y3INER ;COMMAND LIST UNBUFFERED INPUT ZSE
EXTERN Y3ATRE ;POINTER END OF ATR
EXTERN YJOB ;JOB NUMBER
EXTERN YE3LNO ;LINE NUMBER
EXTERN YBHIC2 ;BUFFERHEADER IC2
EXTERN YE3D ;DICTIONARY FOR ERROR MESSAGES
EXTERN YE3M ;TABLE FOR ERROR HANDLING
EXTERN YE3MI ;TABLE FOR ERROR HANDLING
EXTERN YDMEND ;INDEX END OF ZDM
EXTERN Y3OPEN ;STATUSWORD CHANNELS
EXTERN YSIMNAME ;[12] SIMULA class/proc name in Radix50 for global module
EXTERN YATRFIL ;[12] ATR file name in RADIX50 corresp. to YSIMNAME
EXTERN YATRFN,YATRPPN,YATRDEV,YATROFS ;[144]
IFN QDEC20,<;[225]
EXTERN YATRJFN,YFILSP
>
EXTERN ZSE ;SYMBOLTABLE
EXTERN ZLEREC ;RECORD TO KEEP LS1 RECORD
EXTERN E3DB ;CONVERSION DEC ASCII-BIN
LS1INIT
DEFINE IOER(FILE)<
L X1,[ASCIZ/FILE/]>
SUBTTL O3ATR
;PURPOSE: READ ATR.TMP INTO CORE OR MOVE IT TO IDL IF ALREADY IN CORE
;ENTRY: O3ATR
;INPUT ARGUMENTS: -
;NORMAL EXIT: RETURN
;ERROR EXIT: BRANCH O3INER, BRANCH O3LOER
;OUTPUT ARGUMENTS: Y3ATRE POINTER TO POS AFTER ATRLIST
;CALL FORMAT: EXEC O3ATR
O3ATR:
PROC
SAVE <X2>
IF ;ATR.TMP in core
SKIPE YELATR
GOTO FALSE
THEN
LD X0,YBHATR+1
ADDI X1,QOHATE ;[12] allow for END block and two extra words
EXEC O3ATRC ;Ensure space for ATR info
HRRI X0,IDLA
BLT X0,IDLA(X1)
L X2,X1
ELSE
;ATR.TMP IS A DISK FILE
;OPEN FILE,UNBUFFERED MODE
IOER(ATR)
OPEN QCHATR,O3UO
BRANCH O3OPER
SETZM YELATR+3 ;[162] Default path
LOOKUP QCHATR,YELATR
BRANCH O3LOER
HLRE X0,YELATR+3
MOVN X1,X0
ADDI X1,QOHATRE ;[12] allow for END block and two extra words
L X2,X1
;GET MORE CORE IF NOT ENOUGH
EXEC O3ATRC
LI X0,IDLA-1 ;Set up IOWD list in X0, X1 for dump mode input
ADD X0,YELATR+3
LI X1,0
IN QCHATR,X0
SKIPA
;ERROR RETURN
BRANCH [IOER(ATR)
BRANCH O3INER]
EXEC T3A ;[10] DELETE nnnATR.TMP
FI
ADDI X2,IDLA ;[12]
ST X2,Y3ATRE
RETURN
EPROC
SUBTTL O3ATRC
;PURPOSE: GET CORE IF NOT ENOUGH AFTER IDL
;ENTRY: O3ATRC
;INPUT ARGUMENTS: REG X1 CONTAINING SIZE OF CORE NEEDED AFTER IDL
;NORMAL EXIT: RETURN
;ERROR EXIT: BRANCH T3T3
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC O3ATRC
O3ATRC: PROC
SAVE <X2>
LI X2,IDLA(X1) ;[12]
IF
CAMG X2,.JBREL
GOTO FALSE
THEN
;NOT ENOUGH CORE,GET MORE
IFG QTRACE,<EXTERN YTRPAS
IFOFF YTRSW>
CORE X2,
GOTO [;ERROR,CAN'T GET MORE CORE
ERRT QT,560
BRANCH T3T3]
FI
RETURN
EPROC
SUBTTL O3RS
;PURPOSE: READ LS1.TMP
;ENTRY: O3RS
;INPUT ARGUMENTS:
;NORMAL EXIT: RETURN
;ERROR EXIT: RETURN AND SKIP
;OUTPUT ARGUMENTS: REG X1 CONTAINING CONTROL WORD
;CALL FORMAT: EXEC O3RS
; CORRECT RETURN
; END OF FILE RETURN
O3RS:
IF SOSGE YBHLS1+2
GOTO FALSE
THEN ILDB X1,YBHLS1+1
RETURN
FI
IF
SKIPN YELLS1
GOTO TRUE ;IF FILE IN CORE
IN QCHLS1,
GOTO O3RS
STATO QCHLS1,20K
GOTO [IOER LS1
BRANCH O3INER]
THEN ;EOF
AOS (XPDP)
RETURN
FI
SUBTTL O3WS
;PURPOSE: MOVE SOURCE CODE LINE TO LST file
;ENTRY: O3WS
;INPUT ARGUMENTS: X1 points to the line to copy
;NORMAL EXIT: RETURN
;OUTPUT ARGUMENTS:
;CALL FORMAT: EXEC O3WS,<NO> ;NO=NUMBER OF BYTES TO OUTPUT
O3WS: PROC <A>
SAVE <X2>
L X2,A
HRLI X1,440700 ;INIT BYTEPOINTER
LOOP
SOSGE YBHLS3+2
EXEC O3LS3
ILDB X0,X1 ;GET BYTE TO OUTPUT
IDPB X0,YBHLS3+1
AS
SOJG X2,TRUE
SA
RETURN
EPROC
SUBTTL O3LS3
;PURPOSE: OUTPUT BUFFER TO LS3
;RESTRICTIONS: NO REGS MAY BE DESTROYED IN THIS ROUTINE
O3LS3: PROC
OUT QCHLS3,
SOSGE YBHLS3+2
GOTO [IOER LS3
BRANCH O3OUTE]
RETURN
EPROC
SUBTTL O3ERR
;PURPOSE: READ TABLES IN SIMERR.ERR INTO CORE
;ENTRY: O3ERR
;INPUT ARGUMENTS: SIMERR.ERR
;NORMAL EXIT: RETURN
;ERROR EXIT: GOTO O3LOER,GOTO O3OPER RESP GOTO O3INER
;OUTPUT ARGUMENTS: YE3D,YE3DL,YE3M,YE3MI
;CALL FORMAT: EXEC O3ERR
IFE QDEC20,<;[225]
EXTERN YP1DEV,YP1PPN ;[172]
>
O3ERR:
PROC
SAVE <X2,X3> ;[172]
;CREATE COMMAND LIST IN LOWSEG
;***AUBEG
;PARENTHESISE LITERAL FOR KA10 LD MACRO
LD X0,<[IOWD 200,Y3BUFS
0]>
STD X0,Y3INBU
LD X0,<[SIXBIT/SIMERRERR/]>
;***AUEND
STD X0,Y3ERRL
SETZM Y3ERRL+2
L X0,O3ERRP
ST X0,Y3ERRL+3
IFE QDEC20,<;[225] Cannot handle this case on the DEC-20 presently
;[172] Try same area as Pass1 first
LI X0,17 ;Dump mode
L X1,YP1DEV
SETZ X2,
OPEN QCHERR,X0
GOTO L1 ;On failure
LD X0,Y3ERRL
SETZ X2,
L X3,YP1PPN
LOOKUP QCHERR,X0
SKIPA ;Error
GOTO L2
>;[225]
L1():! IOER(ERR) ;[21] MOVED HERE NOT TO BE DESTROYED BY LD X0,
OPEN QCHERR,[EXP 17 ;OPEN FILE
EXP QSYSDEV
0]
GOTO O3OPER ;ERROR RETURN
LOOKUP QCHERR,Y3ERRL
GOTO O3LOER ;ERROR RETURN
SETON YOPERR
L2():! ;INPUT LENGTH OF LISTS ,YE3DL AND THE BEGINNING OF YE3D
;COMMAND LIST (MUST BE IN LOWSEG)
INPUT QCHERR,Y3INBU
STATZ QCHERR,740000 ;CHECK IF ERRORS
GOTO O3INER
;UPDATE COMMAND LIST FOR INPUT
ASSERT <LD X0,Y3BUFS+1
CAIG X0,QE3D
CAILE X1,QE3M
OUTSTR [ASCIZ /TOO LONG ERROR TABLE IN SIMERR/]
L X0,Y3BUFS+3
CAILE X0,300
OUTSTR [ASCIZ /TOO MANY ERROR MESSAGES IN SIMERR/]>
MOVN X2,Y3BUFS+1
ADDI X2,200-4-^D16 ;FIRST BUFFER CONTAINS 4 WORDS
;OF LENGTHS , YE3DL AND THE BEGINNING OF YE3D
MOVN X0,Y3BUFS+2
HRLI X0,YE3M-1
MOVN X1,Y3BUFS+3
HRLI X1,YE3MI-1
IF
JUMPL X2,FALSE
THEN ;YE3DL AND YE3D DO NOT FILL A DISK BUFFER
MOVSM X0,Y3INER
MOVSM X1,Y3INER+1
SETZM Y3INER+2
ELSE
HRLI X2,YE3D+200-4-^D16-1
MOVSM X2,Y3INER
MOVSM X0,Y3INER+1
MOVSM X1,Y3INER+2
SETZM Y3INER+3
FI
;INPUT THE REST OF YE3D, YE3M, YE3MI
INPUT QCHERR,Y3INER
STATZ QCHERR,740000
GOTO O3INER
SETOFF YOPERR
CLOSE QCHERR,
STATZ QCHERR,740000 ;CHECK IF FILE CORRECTLY CLOSED
GOTO O3CLER
RELEASE QCHERR,
SETONA Y3ERR
RETURN
EPROC
SUBTTL O3RA
IFE QDEC20,<;[225]
;PURPOSE: READ .ATR
;ENTRY: O3RA
;INPUT ARGUMENTS: -
;NORMAL EXIT: RETURN
;ERROR EXIT: BRANCH O3INER
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC O3RA
O3RA:
PROC
IN QCHEXT,
SOSGE YBHEXT+2
SKIPA
RETURN
IOER(EXT)
BRANCH O3INER
EPROC
>
IFN QDEC20,<O3RA=O1EXT##> ;[225]
SUBTTL O3RI
;PURPOSE READ ONE WORD FROM IC2.TMP AND/OR INPUT BUFFER FROM IC2
;ENTRY: O3RI TO READ ONE WORD
; O3RIB TO INPUT BUFFER FROM IC2
;INPUT ARGUMENTS:
;NORMAL EXIT: RETURN
;ERROR EXIT: AT END OF FILE : RETURN AND SKIP
;OUTPUT ARGUMENTS: REG X0 CONTAINING WORD FROM IC2.TMP IF ENTRY WAS O3RI
;CALL FORMAT: EXEC O3RI
; CORRECT RETURN
; RETURN AT END OF FILE
O3RI:
WHILE
SOSGE YBHIC2+2
GOTO TRUE
ILDB X0,YBHIC2+1
RETURN
DO
IN QCHIC2, ;INPUT ANOTHER BUFFER
OD
;CHECK IF ERROR/END OF FILE
GETSTS QCHIC2,X0
IF TRNE X0,1B22
GOTO FALSE
O3RIL1:
THEN
IOER(IC2)
BRANCH O3INER
FI
;END OF FILE
AOS (XPDP)
O3RIL:
RETURN
O3RIB: ;INPUT A BUFFER FROM IC2
IN QCHIC2,
RETURN
GOTO O3RIL1
SUBTTL O3RSC
;PURPOSE READ WORDS FROM SOURCE CODE FILE,AND
; REPLACE FAULTY LINE NUMBER IN SOURCE WITH CORRECT NUMBER
; INSERT MISSING END OF LINE CHARACTERS
; OUTPUT TO LIST FILE IF RELEVANT
;ENTRY: O3RSC
;INPUT ARGUMENT: -
;NORMAL EXIT: RETURN
;ERROR EXIT:
;OUTPUT ARGUMENTS: YE3LIN
;CALL FORMAT: EXEC O3RSC
O3RSC:
PROC
SAVE <X2,X3,X4>
LF X3,ZLEIND
IF
IFOFF ZLESRC
GOTO FALSE ;NO LINE IN SOURCE CODE
THEN
;LINE NUMBER IN SOURCE
;SKIP BYTES UNTIL NEXT FULL WORD BOUNDARY
EXEC O3RSC5
;GET LINE NUMBER
EXEC O3RSC6
IF
;CHECK IF LINE NUMBER IS CORRECT
IFOFF ZLEOK
GOTO FALSE
THEN
;CORRECT LINE NUMBER
IF
IFOFFA YE3LST
GOTO FALSE
THEN
;CORRECT LINE NUMBER AND LIST WANTED
TRZ X1,1
SETZB X0,X2
;OUTPUT LINE NUMBER AND CONVERT IT TO BIN
LOOP
LSHC X0,7
SOSGE YBHLS3+2
EXEC O3LS3
IDPB X0,YBHLS3+1
IMULI X2,^D10
SUBI X0,"0"
ADDM X0,X2
LI X0,0
AS
JUMPN X1,TRUE
SA
ST X2,YE3LNO ;SAVE LINENUMBER
ELSE
;CORRECT LINENUMBER,CHECK IF ANY ERRORS
IF
SKIPN YDMEND
GOTO FALSE
THEN
;ERRORS SAVE LINE NUMBER
L X0,X1
EXEC E3DB
ST X1,YE3LNO
FI
FI
FI
FI
HLRZ X4,O3TYP(X3)
IF ;No LST file output
IFONA YE3LST
GOTO FALSE
THEN ;READ ONE SOURCE LINE
EXEC O3RSCT
WHILE
SOJLE X4,FALSE
DO
EXEC O3RSCT
OD
ELSE ;READ SOURCE CODE AND OUTPUT TO LIST FILE
EXEC O3RSC1
;READ END OF LINE CHARACTERS AND OUTPUT TO LIST FILE
WHILE
SOJLE X4,FALSE
DO
EXEC O3RSC2
OD
IF
CAIE X1,QFF
CAIN X1,QVT
GOTO FALSE
THEN
SOSGE YBHLS3+2
EXEC O3LS3
IDPB X1,YBHLS3+1
ELSE
;VT OR FF, VT IS REPLACED BY FF
EXEC E3LICF
FI
HRRZ X4,O3TYP(X3)
;OUTPUT MISSING LINE CHARACTERS
IF ;ONLY LF ;[15R]
JUMPN X3,FALSE
CAIN X2,QCR
GOTO FALSE
THEN
LI X4,QCR
FI
WHILE
JUMPE X4,FALSE
DO
SOSGE YBHLS3+2
EXEC O3LS3
IDPB X4,YBHLS3+1
LSH X4,-7
OD
FI
RETURN
EPROC
;ROUTINE TO READ BYTES FROM SOURCE CODE
;AND OUTPUT TO LIST FILE
O3RSC2:
LOOP
SOSGE YBHLS3+2
EXEC O3LS3
L X2,X1 ;[15R] SAVE LAST CHAR BEFORE LINE CHAR
IDPB X1,YBHLS3+1
O3RSC1:
SOSGE YBHSRC+2
EXEC O3RSCS
ILDB X1,YBHSRC+1
AS
;RETURN FROM O3RSCS IF END OF FILE
CAILE X1,QFF ;[15]
GOTO TRUE
CAIL X1,QLF ;HT CAUSES NO NEW LINE
RETURN
JUMPN X4,TRUE
JUMPN X1,TRUE
SA
;RETURN IF END OF FILE
RETURN
O3RSC5:
;ROUTINE TO READ BYTES FROM SOURCE CODE UNTIL NEXT FULL WORD BOUNDARY
WHILE
L X1,YBHSRC+1
TLNN X1,300000
GOTO FALSE
DO
SOSGE YBHSRC+2
EXEC O3RSCS
IBP YBHSRC+1
OD
RETURN
O3RSC6:
;GET LINE NUMBER FROM SOURCE TO REG X1
LOOP
SOSGE YBHSRC+2
EXEC O3RSCS
MOVNI X0,4
ADDM X0,YBHSRC+2
AOS YBHSRC+1
SKIPN X1,@YBHSRC+1
AS
GOTO TRUE
SA
RETURN
O3RSCS:
;INPUT ANOTHER BUFFER OF SOURCE CODE
IF
IN QCHSRC,
GOTO FALSE
THEN
GETSTS QCHSRC,X0
IF
;END OF FILE ALLOWED ONLY WHEN SOURCE FILE ENDS
;WITH EOF WITHOUT PRECEDING END OF LINE CHARACTERS
TRNN X0,740000
TRNN X0,20000
GOTO FALSE
THEN
JUMPN X4,FALSE
LI X1,0
AOS (XPDP)
RETURN
FI
IOER(SRC)
BRANCH O3INER
FI
SOSGE YBHSRC+2
GOTO O3RSCS
RETURN
;ROUTINE TO READ ONE LINE OF SOURCE CODE,NO OUTPUT TO LS3
O3RSCT:
LOOP
SOSGE YBHSRC+2
EXEC O3RSCS
ILDB X1,YBHSRC+1
AS
CAILE X1,QFF ;[15]
GOTO TRUE
CAIL X1,QLF
RETURN
JUMPN X4,O3RSCT
JUMPN X1,O3RSCT
RETURN
SA
SUBTTL O3SCLS
;PURPOSE: READ SOURCE CODE AND OUTPUT TO LIST FILE
; WITHOUT ANY REARRANGEMENT OF SOURCE CODE.
; CALLED ONLY IF ILLEGAL END OF PROG
;ENTRY: O3SCLS
;INPUT ARGUMENTS: -
;NORMALE EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC O3SCLS
O3SCLS: LOOP
WHILE ;More in current source code buffer
SOSGE YBHSRC+2
GOTO FALSE
DO ;Read and copy to list file
ILDB X0,YBHSRC+1
SOSGE YBHLS3+2
EXEC O3LS3
IDPB X0,YBHLS3+1
OD
IN QCHSRC, ;Get next buffer
AS ;End of file not reached
GOTO TRUE
SA
GETSTS QCHSRC,X0
TRNE X0,1B22
RETURN ;IF END OF FILE
IOER(SRC)
BRANCH O3INER
SUBTTL O3RZ
;PURPOSE: READ SYMBOLTABLE ZSE.TMP INTO CORE
;ENTRY O3RZ
;INPUT ARG:
;NORMAL EXIT: RETURN
;ERROR EXIT: GOTO O3OPER AT ERROR IN OPEN
; GOTO O3LOER AT ERROR IN LOOKUP
; GOTO O3INER AT ERROR IN IN
; GOTO O3CLER AT ERROR IN CLOSE
;OUTPUT ARGUMENTS:
;CALL FORMAT: EXEC O3RZ
O3RZ:
IF
SKIPE YELZSE
GOTO FALSE
THEN ;ZSE IN CORE
LD X1,YBHZSE+1
HRRI X1,ZSE
BLT X1,ZSE(X2)
RETURN
FI
IOER(ZSE) ;USED ONLY IF READ ERROR ON ZSE
OPEN QCHZSE,O3UO ;OPEN FILE
GOTO O3OPER ;ERROR RETURN
L X0,YJOB ;CURRENT JOB NUMBER
HLLM X0,YELZSE
LOOKUP QCHZSE,YELZSE
GOTO O3LOER
SETOFF YPOZSE
L X2,YELZSE+3
HRRI X2,ZSE-1
LI X3,0
IN QCHZSE,X2
SKIPA
BRANCH O3INER
IFE QDEBUG,<;ONLY PRODUCTION VERSION
LI X2,0
RENAME QCHZSE,X2
NOP
>
SETOFF YOPZSE
CLOSE QCHZSE,
STATZ QCHZSE,740000
GOTO O3CLER ;CHECK FOR ERRORS
RELEASE QCHZSE,
RETURN
SUBTTL O3WATR
;PURPOSE: Write ATR file, rename old to .QTR, in the following cases:
; 1. NEWATR is TRUE, i e there is no old ATR module with
; the correct information in the search list.
; 2. [144] The old module was found in a library, and a copy
; is made to the same area as the REL file in order
; to facilitate loading of a SIMULA program using the
; new module.
;ENTRY: O3WATR
;INPUT ARGUMENTS: SWITCHES NEWATR, INLIB AND OLDATR
;NORMAL EXIT: RETURN
;ERROR EXIT: BRANCH T3T3
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC O3WATR
O3WATR:
PROC
SAVE <X2,X3,X4,X5>
SETOM X4
IOER(EXT)
IFN QDEC20,<;[225]
SKIPE YATRJFN ;Close and release JFN
EXEC O1EXCL##
>
MOVS YEXTS+11 ;[225] REL FILE DEV SWAPPED
IF ;[225] NUL:
CAIE 'NUL'
GOTO FALSE
THEN ;NO ATR FILE TO BE WRITTEN
SETOFA NEWATR
SETOFA INLIB
FI
IF ;New ATR file is to be generated
IFONA INLIB ;[144]
GOTO TRUE ;[144]
IFOFFA NEWATR
GOTO FALSE
THEN
IF ;There was an old ATR file with the same name
IFOFFA INLIB ;[20] but not in a library
IFOFFA OLDATR
GOTO FALSE
THEN ;[144] Rename the old ATR file (extension QTR)
EXEC O3WARE
FI ;[144]
L X1,[ASCIZ/EXT/]
LI X2,17 ;[144] Dump mode
SKIPN X3,YEXTS+11 ;REL file device
MOVSI X3,'DSK'
STACK X4 ;[144]
SETZ X4,
OPEN QCHEXT,X2 ;[144]
GOTO O3OPER
UNSTK X4 ;[144]
IFONA NEWATR ;[144]
HLLZS YELEXT+1 ;Clear date info
MOVSI X2,777 ;[222] Data mode is kept
IFONA OLDATR ;[2,222] Copy old atr protection
TLO X2,(777B8) ;[222]
IFOFFA NEWATR ;[222] Keep creation date for copy
TRO X2,-1 ;[222]
IFONA INLIB ;[222] Std protection if copied
TLZ X2,(777B8) ;[222] from library, however
ANDM X2,YELEXT+2 ;Clear unwanted data
L YELREL ;[144] Name from REL file name
ST YELEXT ;[144]
L YELREL+3 ;[144]
ST YELEXT+3 ;[144]
ENTER QCHEXT,YELEXT
BRANCH O3ENER
ST YELEXT+3 ;[144] Restore ppn
;OUTPUT WHOLE BUFFER
;[12] Start of changes
L X2,Y3ATRE
SUBI X2,IDLA+QOHATE ;Compute faked word count for type 0 block
L X2
ADDI X2,^D18
IDIVI X2,^D19
IF ;No remainder
JUMPN X3,FALSE
THEN ;Must adjust word count
ADDI X0,1
LI X3,1
ELSE
SETZ X3,
FI
SUBI X0,(X2) ;Subtract number of reloc words
ST X0,IDLA-1
ADD X3,Y3ATRE
;--- END block ---;
L [5,,2]
ST 0-QOHATE(X3)
SETZB 1-QOHATE(X3)
SETZM 2-QOHATE(X3)
SETZM 3-QOHATE(X3)
LI X2,IDLA-1-QOHATR ; Start of ENTRY block -1
;--- ENTRY block ---;
L [4,,1]
ST 1(X2)
SETZM 2(X2)
L YSIMNAME
ST 3(X2) ;Radix50 SIMULA name
;--- NAME block ----;
L [6,,1]
ST 4(X2)
SETZM 5(X2)
L YATRFIL
ST 6(X2) ;Put file name in name block
MOVN X0,X3
ADDI X0,IDLA-QOHATR+2 ;No extra words
;[12] End of changes
HRL X2,X0
LI X3,0
OUT QCHEXT,X2
SKIPA
BRANCH O3OUTE
IFE QDEC20,<;[225]
FI > ;Put close outside if DEC-10
CLOSE QCHEXT,
STATZ QCHEXT,
BRANCH O3CLER
RELEASE QCHEXT,
IFN QDEC20,<;[225]
FI ;Close inside conditional if DEC-20
SKIPE X1,YATRJFN ;Release JFN
RLJFN
CAI ;Error, don't care
>;[225]
;SETON SWITCH IF OLD ATR FILE IS CORRECTLY DELETED
SKIPN X4
SETONA OLDATR
RETURN
EPROC
SUBTTL O3WARE
;[144] Delete any old QTR file. Rename old ATR file to QTR with standard prot.
;Rename only if the specifications of old and
; new ATR files are identical
;If not, but they are in fact on the same area, the old
; one will be overwritten if not protected.
IFE QDEC20,<;[225] DEC-10 version
O3WARE: PROC
SAVE X1
EXEC O3WAID ;[144] Check for identity
GOTO L9 ;[224] Not identical
SETOFA OLDATR ;TO PREVENT ILLEGAL MSG IF PROT ERROR
L X2,YELEXT
MOVSI X3,'QTR'
SETZ X4, ;Standard protection
L X5,YELEXT+3 ;Same ppn
RENAME QCHEXT,X2
SKIPA ;Did not work
GOTO L9 ;Ok
;There may be an old .QTR around
LI X2,17 ;Dump mode, why not?
SKIPN X3,YEXTS+11 ;REL device
MOVSI X3,'DSK'
SETZ X4,
OPEN X2 ;Use channel 0 to find old QTR file
GOTO L9 ;No use trying more, accept consequences
L YELEXT
MOVSI X1,'QTR'
LD X2,YELEXT+2
LOOKUP
GOTO L2
SETZB X3 ;Zero filename and ppn
RENAME ;Delete the old backup
NOP ;Ignore errors here
L2():! RELEASE
L X2,YELEXT
MOVSI X3,'QTR'
SETZ X4, ;Standard protection
L X5,YELEXT+3 ;Same ppn
RENAME QCHEXT,X2
NOP ;Ignore error
L9():! RETURN
EPROC
>
IFN QDEC20,<;[225]
O3WARE: PROC
SAVE X1
EXEC O3WAID
GOTO L8
SETOFA OLDATR
;Recover file spec string (without ATR)
HRROI X1,YFILSP
HRRZ X2,YATRJFN
L X3,[2B2+2B5+1B8+0B11+JS%PAF]
JFNS
;Append "QTR" as extension
L X2,[POINT 7,[ASCIZ/.QTR/]]
LOOP
ILDB X2
IDPB X1
AS
JUMPN TRUE
SA
HRROI X2,YFILSP
MOVSI X1,(GJ%SHT) ;Short form
GTJFN
GOTO L8 ;Failed
LI X2,(X1) ;JFN
HRRZ X1,YATRJFN
RNAMF ;Do the rename
RLJFN ;Release JFN
L8():! CAIA
L9():! SETZ X4, ;Signal correct rename
RETURN
EPROC
>
SUBTTL O3WAID
;[144] Check for identical spec for old and new ATR file
; Skip return if ok
O3WAID: PROC
n==0 ;Number of stacked words
SKIPN X2,YEXTS+11
MOVSI X2,'DSK'
CAME X2,YATRDEV
GOTO L9
L X3,YATRPPN
IF ;Unequal PPN spec
CAMN X3,YEXTS+7
GOTO FALSE
THEN ;They may still be on the same SFD path
IFN QDEC20,<GOTO L9>;[225] No SFD possible
IFE QDEC20,<;[225]
JUMPE X3,L9 ;Not if just default path
L X2,YEXTS+7
JUMPE X2,L9
TLNN X3,-1 ;Must be pointer
TLNE X2,-1 ;So must the other
GOTO L9
LOOP ;Comparing SFD paths
L 2(X2)
CAME 2(X3)
GOTO L9
AS
JUMPE FALSE
ADDI X2,1
AOJA X3,TRUE
SA
>;[225]
FI ;They are identical!
AOS -n(XPDP)
L9():! RETURN
EPROC
SUBTTL O3WIB
;PURPOSE: WRITE WORDS TO REL file
;ENTRY: O3WIB TO WRITE MORE THAN ONE WORD
;INPUT ARGUMENTS: REG X1 CONTAINING NUMBER OF WORDS TO WRITE,
; REG X0 CONTAINING ADDR OF BUFFER TO OUTPUT
;NORMAL EXIT: RETURN
;ERROR EXIT:
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC O3WIB
O3WIB:
PROC
HRLZ X0,X0
ADD X1,YBHREL
HRR X0,YBHREL
ADDI X1,1
HRRM X1,YBHREL+1
ADDI X0,2
BLT X0,@X1 ;OUTPUT LOCAL BUFFER TO OUTPUT BUFFER
OUT QCHREL,
RETURN
IOER(REL)
BRANCH O3OUTE
EPROC
QO3TNO=560
;PPN FOR SIMERR.ERR
O3ERRP: EXP QERPPN
O3UO: ;OPEN BLOCK UNBUFFERED MODE
EXP 17
SIXBIT /DSK/
0
O3TYP:
;[15]
XWD 1,0 ;LF ;[15R]
XWD 1,QCRLF ;VT
XWD 1,QCRLF ;FF
XWD 2,0 ;LFVT
XWD 2,0 ;LFFF
XWD 0,QCRLF ;ONLY EOF (0)
O3OPER: ERRT QT,Q.TER
BRANCH T3T3
O3INER: ERRT QT,Q.TER+3
BRANCH T3T3
O3OUTE: ERRT QT,Q.TER+4
BRANCH T3T3
O3LOER: ERRT QT,Q.TER+1
BRANCH T3T3
O3ENER: ERRT QT,Q.TER+2
BRANCH T3T3
O3CLER: ERRT QT,Q.TER+5
BRANCH T3T3
LIT
END