;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 ;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 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 LI X2,IDLA(X1) ;[12] IF CAMG X2,.JBREL GOTO FALSE THEN ;NOT ENOUGH CORE,GET MORE IFG QTRACE, 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=NUMBER OF BYTES TO OUTPUT O3WS: PROC SAVE 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 ;[172] ;CREATE COMMAND LIST IN LOWSEG LD X0,[IOWD 200,Y3BUFS 0] STD X0,Y3INBU LD X0,[SIXBIT/SIMERRERR/] 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 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, ;[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 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 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,;[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