cXʊX)h74P}X8U\`9eS}PN؋E[d(ǂ,*VU X3蜞ѕ LOHƅ-OcS\ŔX0霞ԕ LzX$LX%S\+*,)}R` Ĉ=i,EDb,ʢVEmcS)}R` h@ B *F|I :ODuO(-1hDHƅ-OecS\+*,4R LDؓE[d(Ƃ,*VU X4hV}PFÌE[d(Ƃ,*V)f,8eI}PF|=i,EDd,8e*2%cSdԕ LMؓE[d(Ƃ,*VU X3i}PFw,4P}X2U&]XLʊy,R` 85zRX$LXʲVEm5cS*OJP@ @ e d@(J-L̚ i,E8DXRƂf,;eɬX)hˌE[d(%X0Ƃ .NLIST ; .TITLE $F4P ; .IDENT /F4P022/ ;RFB 25-SEP-74 ; PARAMETER FILE FOR FORTRAN IV-PLUS ; ; DISCLAIMER ; ; H. JACOBS, B. LEAVITT, R. BRENDER, D. KNIGHT ; ;+ ; FUNCTION: ; DEFINE COMMON SYMBOLS AND DATA STRUCTURES ; USED THROUGHT THE OTS. ; THE FOLLOWING MACROS ARE CONTAINED HEREIN: ; OTS$I DEFINE CODE SECTION ; OTS$D DEFINE DATA SECTION ; OTSWA DEFINE OTS WORK AREA OFFSETS ; FBLOCK DEFINE FILE DESCRIPTOR BLOCKS ; INCLUDING FCS SYMBOLS ; ERRDEF DEFINE ERROR SYMBOLS USED .NLIST ; .TITLE $ADBDEF -ARRAY DESCRIPTOR BLOCK DEFINITIONS ; IDENT 04 ; ;THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ;EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO ;RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. ; ;THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER ;UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE ;COPIED (WITH INCLUSION OF DIGIT .NLIST ; .TITLE $RSXM -RSX11M PARAMETER FILE ; .IDENT /4PM101/ ; ; DISCLAIMER ; ; R. BRENDER 19-SEP-74 ; RSXM =1 ;SELECT RSX11M SPECIFIC CODE .LIST .NLIST ; .TITLE $FPP ; .IDENT /F4P001/ ; PARAMETER FILE FOR SELECTING FPP ASSEMBLY OPTIONS ; ; DISCLAIMER ; ; R. BRENDER 18-SEP-74 ; FPP =1 ;DEFINE SYMBOL FPP .LIST IN TRAPS ; PDFENT PROCESSOR DEFINED FUNCTION ENTRY POINT EXPANSION ; ;- F4P =1 ;SELECT FORTRAN IV-PLUS CODE PDFH =1 ;SET THE HIDDEN NAMES SWITCH ; THIS CONDITIONAL IS USED TO DEFINE THE SYMBOL '$PASS2' ; ONLY ON PASS TWO OF THE ASSEMBLY. THIS IS USED BY THE FOLLOWING ; LARGE MACROS TO AVOID REDEFINITION ON THE SECOND PASS AND HENCE ; TO SPEED UP THE ASSEMBLY. .IF NDF $PASS1 $PASS1 = 0 .IFF $PASS2 = 0 .ENDC .MACRO IDENT VERSN .IF DF F4 .IDENT /F400'VERSN/ .ENDC .IF DF F AL'S COPYRIGHT NOTICE) ;ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED ;IN WRITING BY DIGITAL. ; ;DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE ;OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED ;BY DIGITAL. ; ;COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION ; ;R. BRENDER 31-MAY-74 ; R. SCHAEFER 11-JUL-74 ; CHANGE ADB DEFINITION ;+ ;FUNCTION: ; A PREFIX FILE TO BE ASSEMBLED WITH MODULES THAT ; MANIPULATE ADBS OR USE DATA TYPE CODE .NLIST ; .TITLE $RSXD ; .IDENT /F4P001/ ; PARAMETER FILE FOR SELECTING RSX11D ASSEMBLY OPTIONS ; ; DISCLAIMER ; ; R. BRENDER 18-SEP-74 ; RSXD =1 ;DEFINE SYMBOL RSXD .LIST .NLIST ; .TITLE F4PDP ; .IDENT /4PD401/ ; ; DISCLAIMER ; ; R. BRENDER 24-SEP-74 ; ;+ ; FUNCTION: ; SELECT FPP DOUBLE PRECIOSION ASSEMBLY ; OPTION FOR CERTAIN OF THE F4P PROCESSOR ; DEFINED FUNCTIONS. ;- FPP =1 ;SELECT FPP OPTIONS F4PDP= =1 ;SELECT DOUBLE PRECISION VERSION .LIST 4P .IF DF RSXD .IF DF RSXDV6 .IDENT /4PD6'VERSN/ .IFF .IDENT /4PD4'VERSN/ .ENDC ;DF RSXDV6 .ENDC ;DF RSXD .IF DF RSXM .IDENT /4PM1'VERSN/ .ENDC ;DF RSXM .ENDC ;DF F4P .ENDM ;IDENT .IF DF FPP!FIS!EIS .IFF .MACRO SOB R,A DEC R BNE A .ENDM ;SOB .ENDC ;DF FPP!FIS!EIS .MACRO OTS$I .ENDM ;OTS$I .MACRO OTS$D .ENDM ;OTS$D .IF DF F4P .MACRO $NEXT$ RTS PC .ENDM .ENDC .IF DF F4 .MACRO $NEXT$ JMP @(R4)+ .ENDM .ENDC .MACRO PDFENT A,B S. ; .MACRO ADBDEF .ENDM ;FORTRAN IV-PLUS ADB USAGE: ; ;FORTRAN IV-PLUS COMPILED CODE USES ADB'S FOR THE FOLLOWING ;CALCUALTIONS: ; ;ADDRESS CALCULATIONS FOR ARRAY FORMAL ARGUMENTS. ;IOAA$ I/O CALL FOR TRANSMITTING AN ENTIRE ARRAY IN AN I/O STATEMTENT. ;OPTIONAL SUBSCRIPT BOUNDS CHECKING, UNDER CONTROL OF A COMMAND-LEVEL ;SWITCH (/CK). ; ;THREE CASES ARE DISTINGUISHED: ; ;1. NON-FORMAL: SHAPE AND STORAGE ADDRESS ARE CONSTANTS, ; THE ENTIRE ADB IS CALCULATED AT COMPILE TIME. ; ; .NLIST ; .TITLE RSXDV6 ; .IDENT /4PD601/ ; ; DISCLAIMER ; ; R. BRENDER 24-SEP-74 ; ;+ ; FUNCTION: ; SELECT RSX VERSION V6A SPECFIC ; ASSEMBLY OPTIONS BY DEFINING SYMBOL 'RSXDV6' ;- RSXD =1 ;SELECT RSX11D SPECIFIC CODE RSXDV6 =1 ;SELECT RSX11D V6A SPECIFIC CODE .LIST .TITLE $EOLHLP -TEMPOARY END-OF-I/O-LIST HELPER .IDENT /P02/ ; ; R. BRENDER 23-JUN-74 ; R. SCHAEFER 11-JUL-74 ; FSF$:: FSU$:: FRF$:: FRU$:: FEF$:: FDF$:: JMP EOLST$ .END  .IF DF PDFI A:: .ENDC ;DF PDFI .IF DF PDFH B:: .ENDC ;DF PDFH .ENDM ;PDFENT ; ; MACRO TO DEFINE THE OTS WORK AREA ; .IF NDF $PASS2 .MACRO OTSWA .IF NDF,$ALOC$ .MACRO DW N,V,G,C N =$$$OFF $$$OFF =$$$OFF+2 .ENDM .IFF .MACRO DW N,V,G,C N =$$$OFF . =$OTSVA+$$$OFF .IF NB,G G ==. .ENDC ;NB,G .IF B,V +0 ;N' 'C .IFF +V ;N' 'C .ENDC ;B,V $$$OFF =$$$OFF+2 .ENDM .ENDC ;NDF,$ALOC$ $$$OFF =0 $TKB$ =0 ;INDICATES LOCATIONS INITIALIZED BY TASK BUILDER2. FORMAL, NON-ADJUSTABLE: SHAPE IS FIXED, BUT STORAGE ; ADDRESSES A0 AND ASTORE ARE CALCUATED AT RUNTIME. ; ;3. FORMAL, ADJUSTABLE: SHAPE AND ADDRESSES VARY. ; ;ARRAY ADDRESS CALCULATION: ; ;DIMENSION A(L1:U1, L2:U2,...) ; ;DEFINE DI=UI-LI+1 ; POLYA(I,J,K)=(((K*D2)+J)*DL+I)*BYTES PERELEMENT ; ; A0=ASTORE-POLYA(L1,L2,L3) ;THEN ; ADDRESS A(I,J,K)=A0+POLYA(I,J,K) ; ;ADB FORMAT: ; ;THE ADB STRUCTURE IS: ; ; L1 (FIRST LOWER BOUND) ; U1 (FIRST UPPER BOUND) ; L2 (ETC) ; U2 NOTE 1 ; .TITLE $CONV -FORTRAN FORMATTED CONVERSION ROUTINES .IDENT /P03/ ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER ; FILE IOASM.CMD ; ; INDIRECT FILE TO ASSEMBLE INPUT/OUTPUT MODULES ; DK1:[300,111]ASSIGN,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]ASSIGN DK1:[300,111]BACKSP,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]BACKSP DK1:[300,111]CKRCN ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]CKRCN DK1:[300,111]CLOSE ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]CLOSE DK1:[300,111]CLSCAL,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]CLSCAL DK1:[300,111]CLSSTM,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]CLSSTM DK1:[300,111]CONV ,LP:=DK1:[100,1 ; HERE FOLLOW THE WORK AREA DESCRIPTIONS ; NOTE: EQUATED SYMBOLS SHOULD NOT BE USED WITHIN ; THE SAME FUNTION. DW W.SEQC , ,$SEQC , DW W.NAMC ,0 ,$NAMC , ENMLNK =W.NAMC DW W.LUNS ,$TKB$ ,.NLUNS ,<# OF LOGICAL UNITS> DW W.MO ,$TKB$ ,.MOLUN , DW W.BFAD ,IOBFAD , , DW W.BLEN ,DFRECL , , DW W.BEND ,IOBFND , , DW LNBUF , , , DW W.IOST ,IOSTAT , , ... ; LN ; UN ; SIZB NOTE 4 ; PWORD NOTE 2 ;A.ADB::ASTORE NOTE 3 ; A0 ; CWORD ; D1 ALWAYS PRESENT IN AN ADB ; D2 ; ... ; DN ; ;NOTE 1: THE LOWER AND UPPER BOUNDS ARE PRESENT IN THE ADB ONLY IF ; ; THE ARRAY IS ADJUSTABLE. NON-VARYING BOUNDS ARE SET ; AT COMPILE TIME, VARYING BOUNDS ARE INITIALIZED TO 0. ; ; ;NOTE 2: THE "PARAMETER WORD" PWORD IS PRESENT ONLY IF THE ; ARRAY IS A FORMAL ARRAY OR IF THE LI,UI ARE PRESENT BECAUSE ; OF BOUNDS CHECKING. ; ; THE VALUE OF PWORD UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; ; ; R. LARY JANUARY 20, 1974 AS A FAVOR TO HERB ; MODIFIED: ; R. BRENDER 22-JUN-74 ; I*4 CONVERSIONS ADDED FOR FORTRAN IV-PLUS10]RSXD,FPP,F4P,[300,110]CONV DK1:[300,111]CONVL ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]CONVL DK1:[300,111]DEFF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]DEFF DK1:[300,111]ENCDEC,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]ENCDEC DK1:[300,111]EOF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]EOF DK1:[300,111]EXIT ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]EXIT DK1:[300,111]FCHNL ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]FCHNL DK1:[300,111]FDBSET,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]FDBSET DK1:[300,111]FIO  DW W.DEV ,DEVTAB , , DW RECIO , , , DW FMTAD , , , DW FILPTR ,0 , , ;DW RECAD , , , DW EOLBUF , , , DW FMTCLN , , , DW BLBUF , , , DW PSCALE , , ,

DW FSTKP , , , DW FSTK , , , NOARG=FSTK ;NO. OF ARGS TIS: ; ; A) NON-ADJUSTABLE ARRAY: POLYA(L1,L2,L3) ; ; B) ADJUSTABLE ARRAY: 2N 1-BIT FIELDS INDICTATING ADJUSTABLE/NON- ; ADJUSTABLE BOUNDS. FORMAT IS SIMILAR TO THE MASK WORD IN ; THE COMPILER SYMBOL DIMENSION RECORD, EXCEPT THAT, IF THERE ARE ; N DIMENSIONS IN THE ARRAY THEN THE 2N LOW-ORDER BITS ; FROM THE DIMENSION RECORD ARE PLACED IN THE 2N HIGH-ORDER ; BITS OF THE ADB. E.G. ; ; PWORD = .DIMDES^(16-2*.DIMS) ; ; ;NOTE 3: THIS IS THE ADDRESS OF THE ADB USED AT RUN ; R.SCHAEFER 11-JUL-74 ; FIX INTEGER CONV FOR -0 ON INPUT ; FIX LEAD 0'S ON REAL OUTPUT ; .GLOBL RCI$,$GET,ICI$,OCI$,ICO$,OCO$ .GLOBL ECO$,FCO$,GCO$,DCO$ .SBTTL INTEGER INPUT CONVERSION OTS$I ;PURE CODE SECTION ;STACK ON ENTRY CONTAINS (IN REVERSE ORDER): ; RETURN PC ; FIELD WIDTH AS A POSITIVE NUMBER ; ADDRESS OF FIRST BYTE OF FIELD OCI$: MOV #7,R2 ;R2 GETS RADIX-1 IN LOW BITS BR IIGO ICI$: MOV #100011,R2 ;DECIMAL FLAG IN SIGN BIT IIGO: MOV (SP)+,R1 ;POP OFF CALLING ,LP:=DK1:[100,110]RSXD,FPP,F4P,ADBDEF,[300,110]FIO DK1:[300,111]FMTCV ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]FMTCV DK1:[300,111]FNBST ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]FNBST DK1:[300,111]GETR ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]GETR DK1:[300,111]GETS ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]GETS DK1:[300,111]INITIP,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]INITIP DK1:[300,111]IOELEM,LP:=DK1:[100,110]RSXD,FPP,F4P,ADBDEF,[300,110]IOELEM DK1:[300,111]IOARYP,LP:=DK1:[100,110]RSXD,FPP,F4P,ADBDE HE LAST FORMAT ITEM EXPECTS PARLVL=FSTK+2 ;PARENTHESIS LEVEL NUMFLG=FSTK+4 ;FLAG INDICATES A NUMBER IS AVAILABLE TO THE ;FORMAT PROCESSOR AND IF IT IS NEGATIVE $$$OFF =$$$OFF+32. ;ALLOWS 8 LEVELS OF PUSHDOWN AT 2 WORDS EACH DW FMTRET , , , DW VARAD , , , DW TSPECP , , , DW TYPE , , , DW REPCNT , , , UNFLGS=REPCNT ;FLAG WORD FOR UNFOR!-TIME ; ;THE ADB "CODE WORD" CWORD CONTAINS ; ; BITS 0-7 ELEMENT SIZE IN BYTES ; BITS 8-10 NUMBER OF DIMENSIONS ; BITS 11-14 DATA TYPE CODE. ;NOTE 4: THIS IS THE ARRAY LENGTH * BYTES PER ELEM ; ;FIELD DEFINITIONS FOR ADB STRUCTURE ; A.UN =-6 ;LAST UPPER BOUND A.SIZB =-4 ;ARRAY SIZE IN BYTES A.PWRD =-2 ;PARAMETER MASK WORD (USE WITH MKAD2$) A.PLYA =-2 ;POLYA(LOWER BOUNDS), (USED WITH MKA1$) A.ASTR = 0 ;ACTUAL STORAGE ADDRESS A.A0 = 2 ;"LOGICAL" BASE ADDRESS A.CWRD = 4 ;C"PC MOV (SP)+,R0 ;POP OFF FIELD WIDTH MOV (SP)+,R3 ;POP OFF FIELD ADDRESS MOV R1,-(SP) ;NOW PUT BACK THE PC $ECI: MOV R2,-(SP) ;AND THE CONVERSION TYPE DESCRIPTOR CLR R1 ;R1 GETS NUMBER .IF DF F4P CLR R4 ;R4 IS HIGH ORDER VALUE .ENDC START: JSR PC,IGET ;GET A CHARACTER BEQ START ;LEADING BLANKS ARE IGNORED TST @SP ;ONLY DECIMAL INPUT CAN BE SIGNED BPL NUMCK ;SO DON'T CHECK IF OCTAL INPUT CMP #'+-' ,R2 ;** REMEMBER, IGET SUBTRACTS A BLANK ** BEQ INEXT ;IGNORE PLUS SIGN #F,[300,110]IOARYP DK1:[300,111]IRF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]IRF DK1:[300,111]IRU ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]IRU DK1:[300,111]ISF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]ISF DK1:[300,111]ISU ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]ISU DK1:[300,111]OPEN ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OPEN DK1:[300,111]OPNSTM,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OPNSTM DK1:[300,111]ORF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]ORF DK1:[300,111]ORU ,LP:=DK1:[100,110]RS$MATTED I/O DW LENGTH , , , DW D , , , DW ITEMSZ , , , DW DOLFLG , , , DW COUNT , , ,<# ITEMS TO TRANSFER, ARRAYS> DW RACNT , , , FMTLP =RACNT ;INFINTE FORMAT LOOP FLAG UNCNT=RACNT ;COUNT OF BYTES IN UNFORMATTED READ DW DENCWD , , , DW W.PC ,0 , , DW EXADDR ,0 , , DW ODE WORD A.BPE = 4 ;BYTES PER ELEMENT - LOW BYTE OF A.CWRD A.D1 = 6 ;FIRST DIMENSION SPAN ; ; ;DATA TYPE CODES: ; ;SYMBOL VALUE TYPE ; A.LGC1 =1 ;LOGICAL*1 (BYTE) A.LGC2 =2 ;LOGICAL*2 A.LGC4 =3 ;LOGICAL*4 A.INT2 =4 ;INTEGER*2 A.INT4 =5 ;INTEGER*4 A.REA4 =6 ;REAL*4 A.REA8 =7 ;REAL*8 (DOUBLE PRECISION) A.CMP8 =8. ;COMPLEX*8 ;A.CM16 =9. ;COMPLEX*16 ;A.CHAR =10. ;CHARACTER A.HOLL =11. ;HOLLERITH ;- .LIST & CMP #'--' ,R2 BNE NUMCK ADD #40000,@SP ;SET NEGATIVE FLAG INEXT: JSR PC,IGET ;GET A "SIGNIFICANT" CHARACTER BEQ IBLANK ;BLANKS ARE ZEROES NOW NUMCK: SUB #'0-' ,R2 CMPB R2,@SP ;CHECK THAT CHAR IS LEGAL IN THIS RADIX BHI IIERR ;SORRY .IF DF F4 IBLANK: ASL R1 ;R1=OLD NUM TIMES 2 BCS IIERR ;OVERFLOW TST @SP ;IF INPUT IS DECIMAL, BPL 1$ ADD R1,R2 ;ADD 2*OLDNUM TO NEW DIGIT 1$: ASL R1 ;NOW FORM 8*OLDNUM + NEW DIGIT BCS IIERR ASL R1 BCS IIERR ;CHECKING FOR OVERFLOW CO'XD,FPP,F4P,[300,110]ORU DK1:[300,111]OSF ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OSF DK1:[300,111]OSU ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OSU DK1:[300,111]OTI ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OTI DK1:[300,111]OTV ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OTV DK1:[300,111]OTVHLP,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]OTVHLP DK1:[300,111]PUTR ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]PUTR DK1:[300,111]PUTS ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,110]PUTS DK1:[300,111]REWIND,LP:=DK1:[100(ENDEX ,0 , , DW ERREX ,0 , , DW W.ECNT ,15. , , DW W.ERNM ,0 , , DW W.MAIN ,MAIN , , DW W.OPFL , , , DW W.ERLN ,ERRLIN , , DW W.ERLE ,ERREND , , DW W.TKNP ,TSKNAM , , DW W.ERTB ,ERRTAB , , DW W.FERR ,0 , , DW W.FER1 ,0 , , DW W.SST ,$SST , , DW W.OBFL ,OBFL , , DW W.OBFH ,OBFH , , DW W.ERUN ,0 , , DW W.FPST , , , DW W.EXJ , , , DW W.PNTY ,0 , , W.IOEF =W.PNTY+1 ;INTERNAL OTS ERROR HANDLING FLAG BYTE DW W.R5 , , , DW W.VTYP , , , DW W.RECL , , , DW W.RECH , , , DW W.FPPF, 0 , , W.DFLT =W.FPPF+1 ;DEFAULT FORMAT CODE BYTE ; LUN MAPPING FOR IMPLIED UNIT I/O STATEMENTS ; THE FOLLOWING MUST BE CONTIGUOUS AND IN ORDER DW W.LNMP ,4 , , .IF DF RSXDV6!RSXM DW W.PRNT ,6 ,$PRINT , DW W.TYPE ,4 ,$TYPE , DW W.ACPT ,5 ,$ACCPT , DW W1SP$:: JSR PC,$SAVP1 MOV @R0,R2 ;GET LUN .IFF BKS$:: MOV @(SP)+,R2 ;GET UNIT NUMBER .ENDC MOV R4,-(SP) ;SAVE R4 JSR PC,$GETFILE ;GET ADDRESS OF FDB BPL 4$ ;IGNORE FOR UNOPENED FILES BIC #DV.RW,@R0 ;MAKE LOOK LIKE READ BIT #DV.DFD,@R0 ;WAS DEFINE EVER DONE? BNE 4$ ;BRANCH TO IGNORE ON RANDOM FILES BIT #DV.APD,D.STA2(R0) ;OPENED AT END-OF-FILE? BNE 7$ ;BRANCH IF SO - CAN'T DO BACKSPACE ADD #D.FDB,R0 ;POINT R0 TO FDB PROPER CLR R1 ;SET ARGS FOR POINT MOV #1,R2 ;SET V2MP @R0 ;RETURN .ENDC ;DF F4P ;GET CHARACTER ROUTINE FOR INTEGER INPUT CONVERSION .IF DF F4 IGET: DEC R0 ;ANY CHARACTERS LEFT IN FIELD? BPL $GET ;YES - GET ONE TST (SP)+ ;NO - WE'RE DONE - POP RETURN ADDR ASL (SP)+ BCC 2$ ;"MINUS SIGN SEEN" FLAG TO CARRY CLC ;NEED CARRY CLEAR FOR OVFLO TEST BPL 1$ NEG R1 ;NOTE NEG SETS CARRY UNLESS R1=0 1$: ROR R1 ;NOW CHECK THAT THE SIGN ROL R1 ;OF THE NUMBER MATCHES THE DESIRED SIGN BVS IIERR1 ;V SET IF C .NE. N - ERROR CLC E INCLUDED ; IN STANDARD [1,1]SYSLIB.OLB SINCE GLOBAL ; SYMBOL CONFLICTS WILL RESULT. ;- OTS$I ;PURE CODE SECTION .GETSQ:: JMP .GET .PUTSQ:: JMP .PUT .END 4.READ ,1 ,$READ , .IFF DW W.PRNT ,5 ,$PRINT , DW W.TYPE ,6 ,$TYPE , DW W.ACPT ,6 ,$ACCPT , DW W.READ ,4 ,$READ , .ENDC ;DF RSXDV6!RSXM ; END OF CONTIGUOUS GROUP DW W.MOPR ,$MOPRM , , DW W.MOV1 , ,$MOPRM , DW W.MOA1 , , , DW W.MOV2 , , , DW W.MOA2 , , ,,F.ERR(R0) ;AT END-OF-FILE? BEQ 6$ ;BRANCH IF SO 7$: ERROR BACKSP ;BACKSPACE ERROR BR 4$ 1$: $AOTS ;RESET WORK AREA POINTER MOV D.RCCT-D.FDB(R0),R2 ;GET RECORD COUNT DEC R2 ;DECREMENT BGT 5$ 6$: CLR R2 5$: MOV R2,D.RCCT-D.FDB(R0) ;RESTORE BLE 4$ ;BRANCH IF AT START OF FILE 2$: JSR PC,GETREC ;GET A RECORD SOB R2,2$ ;LOOP TIL COUNT EXHAUSTED 4$: CLR FILPTR(R3) ;SET I/O SYST6 ;CLEAR ERROR INDICATOR 2$: JSR R1,@(SP)+ ;RETURN, REPLACING PC ON STACK WITH RESULT .ENDC ;DF F4 $GET: MOVB (R3)+,R2 ;GET BYTE OF INPUT BIC #177600,R2 ;CLEAR NUISANCE BITS SUB #' ,R2 ;SUBTRACT BLANK FOR CODE SAVINGS RTS PC .IF DF F4P IGET: DEC R0 ;ANY CHARACTERS LEFT? BPL $GET ;BRANCH IF SO ; ; NO MORE INPUT SO RETURN ; INO: TST (SP)+ ;POP IGET RETURN ADDR ASL (SP)+ ;CAN THIS NUMBER HAVE SIGN? BCC IRET ;RETURN IF NOT CLC ;NEED CLEAR FOR OVFLW TEST BPL 1$ ;BR7 .TITLE $DEFF DEFINE FILE AND FIND STATEMENT PROCESSING IDENT 07 ;RFB 26-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 17-JUN-74 ; R. SCHAEFER 16 JUL 74 ; ;+ ; FUNCTION: ; PROCESS DEFINE FILE AND FIND STATEMENTS. ; ; ; CALLING SEQUENCE FOR DEFINE FILE: ; ; PUSH ; PUSH ; PUSH ; PUSH ; PUSH ; JSR PC,$DEFF ; ; RETURNS WITH ARGUMENTS DELETED AND ; CONTEXT PRESERVE STRING ADDRESS> DW W.MOTR , , , DW W.MOT2 , , , DW W.MOTY , , , $$$OFF =W.READ+40. ;EXPANSION ROOM ; END OF WORK AREA DW W.END , , , .MACRO $AOTS REG .IF B REG MOV @#$OTSV,R3 .IFF MOV @#$OTSV,REG .ENDC ;B REG .ENDM ;$AOTS .IF DF F4P ; SYMBOLS USED IN THE I/O INITIALIZATION ROUTINES IN ; CALLING $INITIO FL.ERR =100000 ;EM INACTIVE MOV (SP)+,R4 ;RESTORE R4 $NEXT$ ;RETURN ; ; GET ONE FORMATTED, UNFORMATTED, OR END-FILE RECORD ; GETREC: GET$S ;GET SOMETHING BCC 1$ ERROR BACKSP 1$: BIT #DV.UFP,@FILPTR(R3) ;UNFORMATTED UNIT? BEQ 2$ ;EXIT IF FORMATTED CMP #1,F.NRBD(R0) ;UNFORMATTED & 1 BYTE => END-FILE RECORD BEQ 2$ BITB #2,@F.NRBD+2(R0) ;LAST SEQMENT BIT? BEQ GETREC ;LOOP IF NOT 2$: RTS PC .END FANCH IF NO SIGN WAS SEEN NEG R1 ADC R4 NEG R4 1$: ROR R4 ROL R4 ;V SET IF C .NE. N BVS IIERR1 ;BRANCH ON OVERFLOW CLC ;SET NO ERROR BR IRET ;AND RETURN .ENDC ;DF F4P .SBTTL REAL AND DOUBLE INPUT CONVERSION ;DEFINITIONS OF STACK OFFSET VARIABLES: IOVFLC= 14. ;COUNT OF OVERFLOW DIGITS ILEN= 12. ;LENGTH OF INPUT FIELD IP= 8. ;SCALE FACTOR ;STACK ON ENTRY CONTAINS (IN REVERSE ORDER): ; RETURN PC ; P FACTOR ; D SPECIFICATION ; FIELD WIDTH ; FIELD START ADDRESS GED. ; ;- OTSWA ERRDEF FBLOCK .MCALL FDAT$R,FDOP$R OTS$I ;PURE CODE SECTION DEFF$:: JSR PC,$SAVP6 ;SAVE STATE MOV R0,R4 ;MOVE R0 OUT OF WAY OF $FCHNL MOV 10.(R4),R2 ;GET UNIT NUMBER JSR PC,$GETFILE ;GET DEVICE BLOCK TO R0 BMI 1$ ;BRANCH IF OPEN-ERROR BIT #DV.DFD,@R0 ;DEFINE FILE DONE? BNE 2$ ;BRANCH IF SO - ERROR BIC #^CDV.AI4,@R4 BIS (R4)+,D.STA2(R0) MOV (R4)+,D.AVAD(R0);KEEP ASSOC. VAR. ADDR MOV (R4)+,R1 ;RECORD SIZE IN WORDS MOV (R4)+,D.RCNM(R0) ;LOW ORDER NU """"""" """@@DDDDD@DDDDDDDDDDDDDDDDDDD """"""""""" "" @DD """DD @DDD """DD """DDD"""DD@DDADDB B C*kQ}kQ!s@QkQ(kQskQ  (kQ0  skQ#!3kQ&kQ;2:x' GkQ%5S.xQkQ+/%kQ3K&`kQHT!kQfO[E`WkQYXykQ_ &`YkQ+'0kQs!kQy:x~kQ N`ykQ K f9kQ;kQ~:xtkQ%;kQ'ykQ`kQ= `kQwkQ  kQ>;kQ M;kQ&`kQkQM $`kQ!1`kQ(@_qt:kQ*6 #}kQk//&kQ3.vqkQv5M,pkQ:>,vkQBN:KkQaD\`kQQe`3kQRV\gpkQZb\gvkQ`l"&wkQfv$DwwwẅIEND=/ERR= PRESENT FL.ENC = 44000 ;ENCODE/DECODE STATEMENT FL.FMT = 21000 ;FORMAT PRESENT FL.REC = 12000 ;DIRECT ACCESS RECORD NUMBER PRESENT FL.WRT = 600 ;WRITE OPERATION (WITH IMPLIED OPEN) FL.RD = 200 ;READ OPERATION (WITH IMPLIED OPEN) .ENDC ;DF F4P ;IF NO ALLOCATION THEN DEFINE OTSWA NULL ;FOR FASTER ASSEMBLY .IF NDF $ALOC$ .MACRO OTSWA .ENDM .ENDC .ENDM ;OTSWA .ENDC ;NDF $PASS2 ; ; DESCRIPTOR MACRO FOR FILE DESCRIPTION BLOCKS ; .IF NDF $PASS2 .MACRO FBLOCK NOJ RCI$: MOV SP,R0 ;SAVE POINTER TO PC WORD MOV R4,-(SP) ;SINCE WE WILL SAVE SOME REGS MOV R5,-(SP) CMP (R0)+,(R0)+ ;BUMP PAST PC WORD AND P FACTOR MOV (R0)+,-(SP) ;GET "D" SPECIFICATION TST (R0)+ ;BUMP PAST FIELD WIDTH ("W" SPECIFICATION) MOV @R0,R3 ;GET POINTER TO FIELD CLR @R0 ;WE WILL USE THIS WORD FOR IOVFLC JSR PC,CLEAR ;CLEAR R0,R1,R4,R5 (THE "FAC") 1$: JSR PC,RGET ;GET A CHAR BEQ 1$ ;IGNORE LEADING SPACES CMP #'+-' ,R2 ;CHECK FOR SIGNS BEQ RINEXT CMP #'--' ,R2 BNE RNKMBER OF RECORDS MOV (R4)+,D.RCNM+2(R0) ;HIGH ORDER WORD BMI 5$ ASL R1 ;WORD COUNT TO BYTE COUNT BVS 4$ ;OVERFLOW MEANS NO GOOD 7$: BIS #DV.DFD!DV.UFP,@R0 ;SET DEFINEFILE DONE & UNFORMATTED ADD #D.FDB,R0 ;MAKE FDB ADDR FDAT$R R0,,,R1 ;SET RECORD LENGTH 6$: CLR FILPTR(R3) ;RELEASE I/O SYSTEM RTS PC ;RETURN 1$: ERROR DFLOPN ;DEFINE FILE ON OPEN FILE BR 6$ 2$: ERROR DEFDEF ;DEFINE FILE ALREADY DONE BR 6$ 5$: ERROR BADRCN ;BAD RECORD NUMBER 3$: BIC #DV.AI4,D.STA2(R0) BR 6$ 4L .TITLE $CONVL -FORTRAN LOGICAL CONVERSIONS .IDENT /P01/ ; ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UNDMFCS ;A FILE DESCRIPTOR BLOCK IS INITIALLY ALLOCATED ZEROED ;CLOSE SHOULD RE-ZERO BLOCK D.STAT=0. ;STATUS WORD 1, BITS DEFINED BELOW D.STA2=2. ;STATUS WORD 2 " " " D.RCNM=4. ;NUMBER OF RECORDS (DEFINE FILE) RAN.. D.RCCT=D.RCNM ;RECORD COUNT (FOR BACKSPACE) SEQ.. D.RCN2=6. ; NO. OF RECS, 2ND WORD RAN.. D.RCC2=D.RCN2 ; REC CNT, 2ND WORD SEQ.. D.AVAD=8. ;ADDR OF ASSOC VAR (DEFINE FILE) D.SPAR=10. ;SPARE WORD D.FDB=12. ;START OF RSX 11 M/D FDB ;STATUS BITS ;WORD ONE - D.STAT NUMCK BIS #40000,@SP ;SIGN FLAG IN UPPER BYTE OF D SPEC WD RINEXT: JSR PC,RGET ;GET A SIGNIFICANT CHARACTER BEQ RBLANK ;BLANKS ARE EQUIVALENT TO ZEROES HERE RNUMCK: SUB #'0-' ,R2 CMP R2,#9. ;CHECK FOR DIGGIT BHI NOTDIG ;NOPE RBLANK: CMP R0,#3275. ;SEE IF FAC CAN BE MULTIPLIED BY 10 BLOS 1$ ;YES - GO DO IT INC IOVFLC(SP) ;NO - IT WOULD OVERFLOW - THIS IS AN BR 2$ ;OVERFLOW DIGIT - LOG IT AND CONTINUE 1$: JSR PC,MUL5 ;MULTIPLY BY 10 - MULTIPLY BY 5 JSR PC,LEFT ;AND DOUBLE ADD R2$: ERROR DEFBIG ;DEFINE FILE RECORD EXCEEDS MAXBUF BR 3$ ;+ ; CALLING SEQUENCE FOR FIND: ; ; PUSH ; PUSH ; JSR PC,FIND$ ; ;- .IF DF F4P FIND$:: JSR PC,$SAVP3 .IFF FND$:: .ENDC MOV #FL.REC!FL.RD,R1 JSR PC,$INITIO MOV D.AVAD(R0),R1 BEQ 2$ ;BRANCH IF NO ASSOCIATED VARIABLE MOV W.RECL(R3),(R1)+ .IF DF F4P BIT #DV.AI4,D.STA2(R0) BEQ 2$ MOV W.RECH(R3),@R1 .ENDC 2$: CLR FILPTR(R3) $NEXT$ .END PER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. .GLOBL LCO$,LCI$ OTS$I ;PURE CODE SECTION ;THESE ARE CALLED WITH A JSR PC ;IF OUTPUT - VALUE ON TOS ;FIELD WIDTH QDV.FNB =4 ;FILE NAME BLOCK INITIALIZED DV.DFD =10 ;DEFINE FILE DONE DIRECT ACCESS UNIT DV.FACC =40 ;FILE ATTRIBUTES: 0 - DEFAULT ; 1 - CALL FDBSET DV.OPN =200 ;UNIT OPEN MUST BE 200'S BIT DV.FMP =2000 ;FORMATTED ACCESSED UNIT DV.UFP =4000 ;UNFORMATTED ACCESSED UNIT DV.ASGN =10000 ;FILESPEC: 0 - USE DEFAULT ; 1 - FROM CALL ASSIGN DV.CLO =20000 ;CLOSE IN PROGRESS DV.FRE =40000 ;FREE FORMAT ALLOWED DV.RW =100000 ;CURRENT OPERATION: 0 - READ ; 1 - WRITE ;WORD TWO - D.STAR,R5 ;ADD IN NEW DIGIT ADC R4 ;PROPAGATE CARRIES ADC R1 ADC R0 2$: TST @SP ;IF WE HAVE HIT A DECIMAL POINT, BPL RINEXT INC @SP ;BUMP THE D SPECIFICATION UP BR RINEXT NOTDIG: CMP R2,#'.-'0 ;CHECK FOR DECIMAL POINT BEQ DECPNT ;YES SUB #'D-'0,R2 ;CHECK FOR D OR E ASR R2 BEQ EXPON INC R2 ;NOT D OR E - BUT + OR - ROR R2 ;IS EQUIVALENT TO "E+" OR "E-" ADD #<'D-'+>/4,R2 ;BY THE BLESSED BEQ EXPONX ;FORTRAN STANDARD RIERR: MOV #STORE,R3 ; E R R O R - SET ERROR FLAG (R3) MOS .TITLE $EOF ENDFILE STATEMENT PROCESSOR IDENT 04 ;RFB 24-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UTON TOS ;START ADDRESS OF FIELD NEXT LCI$: MOV (SP)+,R3 ;RETURN ADDR TO R3 MOV (SP)+,R2 ;SIZE OF FIELD TO R2 MOV @SP,R1 ;START ADDRESS OF FIELD CLR @SP ;SET DEFAULT TO FALSE, CLEAR C 2$: DEC R2 ;ARE WE AT END OF FIELD? LEAVES C ALONE BMI 3$ ;HIT END OF FIELD, RETURN C CLEAR CMPB #'F,@R1 ;IS IT AN F BEQ 3$ ;BRANCH IF YES, C CLEAR CMPB #'T,@R1 ;IS IT A T BNE 1$ ;BRANCH IF NOT DEC @SP ;SET TRUTH VALUE, C IS CLEAR 3$: JMP @R3 ;RETURN 1$: CMPB #' ,(R1)+ ;IS IT A BLANK BEQ 2$U2 DV.AI4 =2 ;DEFINEFILE ASSOC VAR: 0 - I*2 ; 1 - I*4 DV.CC =10 ;EXPLICIT CARRIAGE CONTROL SPECIFIED DV.SPL =20 ;DISPOSE = 'PRINT' DV.DEL =40 ;DISPOSE = 'DELETE' DV.RDO =400 ;READONLY DV.UNK =1000 ;TYPE = 'UNKNOWN' DV.OLD =2000 ;TYPE = 'OLD' DV.NEW =4000 ;TYPE = 'NEW' DV.SCR =10000 ;TYPE = 'SCRATCH' DV.APD =20000 ;ACCESS='APPEND' DV.SAV =40000 ;DISPOSE='SAVE' ; ;MAPPING OF RSX 11 FDB ; .MCALL FDOF$L FDOF$L F.FDB =S.FDB+D.FDB ;SIZE OF FORTRAN DEVICE BLOCK .IF BVV R3,-(SP) ;NON-ZERO AND FAKE A CALL TO "CLEAR" CLEAR: CLR R0 CLR R1 CLR R4 ; (SELF - EXPLANATORY) CLR R5 RTS PC DECPNT: ADD #100000,@SP ;SET DECIMAL POINT FLAG IN D SPEC WORD BCS RIERR ;IF IT WAS ALREADY SET, ERROR CLRB @SP ;CLEAR D SPECIFICATION SINCE BR RINEXT ;DECIMAL POINT OVERRIDES IT. EXPONX: DEC R3 ;+ OR - SEEN WITHOUT "E" OR "D" - INC ILEN(SP) ;BACK UP CHAR POINTER AND COUNTER. EXPON: MOV R0,-(SP) ;FLOATING CONVERSION NOW CALLS MOV R1,-(SP) ;INTEGER INPUT CONVWNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER FOR IV-PLUS 20-JUNE-74 ; OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION .IF DF F4P ;BRANCH IF YES TO LOOK AT NEXT SEC ;SET ERROR FLAG JMP @R3 ;RETURN LCO$: MOV (SP)+,R3 ;RETURN ADDR TO R3 MOV (SP)+,R2 ;VALUE TO R2 MOV (SP)+,R1 ;WIDTH OF FIELD MOV (SP)+,R0 ;START OF FIELD 1$: DEC R1 ;TEST FOR 1 SPOT LEFT IN OUTPUT FIELD BEQ 2$ ;BRANCH IF SO TO FILL IN CHAR MOVB #' ,(R0)+ ;BLANK THIS POSITION BR 1$ 2$: MOVB #'T,@R0 ;ASSUME VALUE TRUE TSTB R2 ;NOW CHECK IT, CLEAR C BIT BNE 3$ ;BRANCH IF TRUE MOVB #'F,@R0 ;MAKE IT FALSE 3$: JMP @R3 ;RETURN .END Y NOFCS ; ;FCS BIT ASSIGNMENTS ; .MCALL FCSBT$ FCSBT$ DEF$L ; ;I/O ERROR CODES DEFINITIONS ; .MCALL QIOSY$ QIOSY$ .ENDC ;B NOFCS ; .MACRO FBLOCK NOFCS .ENDM ;FBLOCK ; .ENDM ;FBLOCK .ENDC ;NDF $PASS2 ; ;MACRO FOR ERROR CONTROL BYTE DEFINITIONS ; .IF NDF $PASS2 .MACRO ERRDEF OPT .IF B OPT .MACRO DE NAME,NUM,VALUE,TEXT NAME =NUM .ENDM .ENDC ;B OPT ;BIT NAMES EC.CON =1 ;CONTINUE EC.CNT =2 ;COUNT THIS ERROR EC.UER =4 ;USE ERR=EXIT EC.LOG ZERSION AT A SPECIAL MOV ILEN+4(SP),R0 ;ENTRY POINT TO PICK UP MOV R4,-(SP) MOV #100011,R2 ;THE EXPONENT (IN DECIMAL). JSR PC,$ECI .IF DF F4P MOV (SP)+,R2 ;LOW ORDER MOV (SP)+,R1 ;HIGH ORDER BCS 4$ ;BRANCH IF ERROR FROM $ECI BEQ 1$ ;BRANCH IF HIGH ORDER OKAY + INC R1 ;REASONABLE MINUS VALUE GIVES 0 BNE 2$ ;BRANCH IF NOT TST R2 ;THIS MUST BE MINUS TOO BPL 2$ ;BRANCH IF NOT BR 3$ ;GOOD I*2 VALUE 1$: TST R2 ;HIGH IS PLUS - SO LOW MUST BE TOO BPL 3$ ;BRANCH IF SO 2$[ ENDF$:: JSR PC,$SAVP1 MOV @R0,R2 ;GET UNIT NUMBER .ENDC ;DF F4P .IF DF F4 EOF$:: MOV @(SP)+,R2 ;GET UNIT NUMBER .ENDC ;DF F4 JSR PC,$GETFILE ;GET FDB ADDRESS BPL 3$ ;BRANCH IF FILE UNOPENED TST @R0 ;WAS LAST OPERATION READ? BMI 3$ ;BRANCH IF WRITE MOV F.URBD+2+D.FDB(R0),F.NRBD+2+D.FDB(R0) ;FOR READ,WRITE USE USER RECORD ;BUFFER FOR WRITE 3$: BIT #DV.DFD,@R0 ;IS THIS A RANDOM FILE? BNE 4$ ;BRANCH IF IT IS TO IGNORE ENDFILE BIS #DV.RW,@R0 ;LOOK IT LIKE WRITE S\ .TITLE $OPEN -FILE OPEN AND DEFAULT NAME ROUTINES IDENT 15 ;RFB 30-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE P]=8. ;LOG THIS ERROR EC.INU =16. ;THIS ERROR NUMBER IN USE EC.RTS =32. ;RTS CONTINUE OKAY EC.ERE =64. ;ERR=CONTINUE OKAY ; ;COMMON COMBINATIONS ; EC.IO =EC.CON!EC.CNT!EC.UER!EC.LOG!EC.ERE!EC.INU EC.NRM =EC.CON!EC.CNT!EC.LOG!EC.RTS!EC.INU EC.FAT =EC.LOG!EC.INU ; ;THE DEFINITIONS FOLLOW: ; ERCLS0 =128. ;USER NUMBER 0 DE ERINVE ,ERCLS0+1 ,EC.FAT , DE ERINIT ,ERCLS0+2 ,EC.FAT , DE ERSST0 ,ERCLS0+3 ,EC.FAT , DE ERS^: SEC ;SIGNAL ERROR BR 4$ 3$: CLC ;SIGNAL OKAY 4$: .IFF MOV (SP)+,R2 ;GET EXPONENT .ENDC MOV (SP)+,R4 MOV (SP)+,R1 ;RESTORE REGISTERS THAT MOV (SP)+,R0 ;INPUT ROUTINE DESTROYS BCS RIERR ;CHECK FOR ERROR IN EXPONENT CONVERSION BR SCALE RGET: DEC ILEN+2(SP) ;ANY MORE CHARS? BPL $GET ;YES - GET ONE TST (SP)+ ;RAN OUT - POP OFF CALLING PC MOV IP(SP),R2 ;NO EXPONENT SO P SCALE FACTOR APPLIES NEG R2 ;IN REVERSE SCALE: MOV R0,R3 BIS R1,R3 BIS R4,R3 ;IF INPUT NUO IT IS NEW TSTB @R0 ;IS FILE OPENED? BMI 1$ ;BRANCH IF IT IS JSR PC,$OPEN ;OPEN THE FILE 1$: MOVB #'Z-100,@F.NRBD+2+D.FDB(R0) ;MAKE A 1 BYTE FLAG RECORD MOV #1,R1 ;SET SIZE OF 1 FOR PUTS JSR PC,$PUTS ;OUTPUT THE ^Z RECORD 2$: CLR FILPTR(R3) ;SIGNAL NO I/O IN PROGRESS $NEXT$ 4$: ERROR EREOFR ;ENDFILE ON RANDOM UNIT BR 2$ .END `URCHASER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER 27-JUN-74 ; ;ON ENTRY ; R0 CONTAINS ADDR OF LUN BLOCK ; R2 CONTAINS FORTRAN CHANNEL NUMBEaST1 ,ERCLS0+4 ,EC.FAT , DE ERSST2 ,ERCLS0+5 ,EC.FAT , DE ERSST3 ,ERCLS0+6 ,EC.FAT , DE ERSST4 ,ERCLS0+7 ,EC.FAT , DE ERSST5 ,ERCLS0+8. ,EC.FAT , DE ERSST6 ,ERCLS0+9. ,EC.FAT , DE ERSST7 ,ERCLS0+10. ,EC.FAT , .IF DF FPP DE ERFP00 ,ERCLS0+11. ,EC.FAT , DE ERFP02 ,ERCLS0+12. ,EC.FAT , DE ERFP12 ,ERCLS0+13. ,EC.FAT , DE ERFP14 ,ERCLS0+14. ,EC.FAT , .ENDC ;DF FPP ERCLS1 =ERCLS0+20. ;20 DE REWIND ,ERCLS1+0 ,EC.IO , DE DEFDEF ,ERCLS1+1 ,EC.IO , DE RECLNG ,ERCLS1+2 ,EC.IO , DE BACKSP ,ERCLS1+3 ,EC.IO , DE ENDERR ,ERCLS1+4 ,EC.IO , DE BADRCN ,ERCLS1+5 ,EC.IO , DE NODEFL ,ERCLS1+6 ,EC.IO , DE ERMLTR ,ERCLS1+7 ,EC.IO , DE NCLOSE ,ERCLS1+8. ,EC.IO , DE NOSUCH ,ERCLS1+9. ,EC.IO , DE NOOPEN ,ERCLS1+10. ,EC.IO , DE MIXFUF ,ERCLS1+11. ,EC.IO , DE BADCHN ,ERCLS1+12. ,EC.IO , DE EREOFR ,ERCLS1+13. ,EC.NRM-EC.CNT , DE FILOPN ,ERCLS1+14. ,EC.IO , DEFOPN =FILOPN DFLOPN =FILOPN DE ERLNAT ,ERCLS1+17. ,EC.IO , DE BADPUT ,ERCLS1+18. ,EC.IO , DE BADGET ,ERCLS1+19. ,EC.IO , DE IOINIO ,ERCLS1+20. ,EC.FAT , DE NBUFRM ,ERCLS1+21. ,EC.IO , DE NDEVLD ,ERCLS1+22. ,EC.IO , DE BADSPC ,ERCLS1+23. ,EC.NRM , DE DEFBIG ,ERCLS1+24. ,EC.IO , .IF DF F4P BDOPRC =DEFBIG DE BDOPFS ,ERCLS1+25. ,EC.IO , DE ERIFAR ,ERCLS4+5 ,EC.NRM , DE ERINEN ,ERCLS4+6 ,EC.NRM , ERCLS5 =ERCLS4+10. ;90 .IF DF F4 DE COMPER ,ERCLS5+0 ,EC.FAT , .ENDC ;DF F4 DE CMRNGE ,ERCLS5+1 ,EC.CON!EC.RTS!EC.INU , .IF DF F4P DE ERAGO ,ERCLS5+2 ,EC.NRM , .ENDC DE ERDILE ,ERCLS5+3 ,EC.NRM , DE ARYREF ,ERCLS5+4 ,EC.NRM , ERCLS6 =ERCLS5+10. ;100 DE ERDIR0 ,ERCLS6+0 ,EC.FAT , DE ERDIR1 ,ERCLS6+1 ,EC.FAT , ERMAXN =ERCLS6+10. ;110 .MACRO ERROR NUM TRAP+NUM .ENDM .IF B OPT .MACRO ERRDEF OPT .ENDM .ENDC .ENDM ;ERRDEF .ENDC ;NDF $PASS2 .LIST 0 ;KEEP DIVIDING MOV R0,-(SP) ;SAMEFOR NEXT WORD MOV R1,R0 MOV R4,R1 DIV #40.,R0 MOV R0,-(SP) MOV R1,R4 ;FINALLY FORM LAST DOUBLEWORD DIV #80.,R4 ;LOW-ORDER QUO IN R4, REM IN R5 MOV R5,R1 CLR R0 DIV #10.,R0 ;SEPARATE OUT THE REAL REM FROM THE HACK REM MOV R4,R5 ;LOW QUO TO R5 MOV (SP)+,R4 MOV R1,R3 ;SAVE REAL REM MOV (SP)+,R1 ASL R5 ASHC #2,R4 ROL R1 ADD R0,R5 ;FAKE REM REALLY PART OF QUO MOV (SP)+,R0 ASH #12.,R3 ;SHIFT REMAINDER TO HIGH BITS RTS PC .IVERY LARGE LUN NUMBER BIS #100000,W.OPFL(R3) ;SET CATASTROPHIC ERROR RETURN .SBTTL DISPOSE ; DISPOS ; ; FUNCTION ; MARK FILE FOR PRESERVATION OR DELETION ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; SAVE=1 DELETE=2 SPOOL=3 DISPOS: BIC #DV.DEL!DV.SPL!DV.SAV,D.STA2(R4) ;CLEAR THE OLD DISPOSITION CMP 2(R5),#DELETE ;MARK FILE FOR DELETION? BNE 1$ ;NO BIS #DV.DEL,D.STA2(R4) ;MARK FILUCH ;NO SUCH FILE ERROR BR ERROUT 4$: CMPB #IE.NBF,R2 ;NO ROOM IN FSR? BNE 5$ ;BRANCH IF DIFFERENT ERROR ERROR NBUFRM ;NO BUFFER SPACE AVAILABLE BR ERROUT 5$: ERROR NOOPEN ;GENERAL OPEN FAILED ERROR BR ERROUT 3$: CMPB #IE.HWR,R2 ;HANDLER MISSING? BNE 5$ ;USE CATCH ALL ERROR ERROR NDEVLD ;HANDLER TASK NOT RESIDENT ERROR ERROUT: BIC #DV.DEL!DV.SPL,D.STA2(R1) ;CLEAR FANCY STUFF BITB #FA.CRE,F.FACC(R0) ;DID WE MAKE A FILE? BEQ 1$ ;BRANCH IF NOT BIS #DV.DEL,D.STA2(R1) ;ASK FOR .TITLE $FCHNL -MAP LUN TO DEVICE TABLE ADDRESS IDENT 06 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCFF DIV10: MOV #74,R3 ;DIVIDE R0,R1,R4,R5 BY 10 1$: CMP #50000,R0 ;A SIMPLE SHIFT AND SUBTRACT ALGORITHM BHI 2$ ;IS BOTH SHORTER AND FASTER ADD #130000,R0 ;THAN THE MORE COMPLICATED FPMP ROUTINE. 2$: ROL R5 ;TRUE, IT ONLY PRESERVES 60 BITS OF A ROL R4 ;OF ACCURACY, BUT THEN THE FLOATING ROL R1 ;POINT FORMAT ONLY HAS 56. ROL R0 DEC R3 BNE 1$ MOV R0,R3 ;COPY HIGH QUO + REM TO R3 BIC #7777,R3 ;R3 CONTAINS REMAINDER INHIGH BITS BIC R3,R0 ;CLEAR OUT REMAINDER BITS FROM HIGH QUO E FOR DELETION BR 3$ 1$: BIT #DV.SCR,D.STA2(R4) ;SCRATCH FILE BEQ 2$ ;CANNOT BE SAVED OR SPOOLED ERROR BDOPSC INC W.OPFL(R3) RETURN 2$: CMP 2(R5),#SPOOL ;DO WE SPOOL IT? BNE 5$ ;NO BIS #DV.SPL,D.STA2(R4) ;MARK FILE FOR SPOOLING 3$: BIT #DV.RDO,D.STA2(R4) ;IS IT READONLY? BEQ 4$ ;BRANCH IF NO ERROR BDOPDE INC W.OPFL(R3) BIC #DV.DEL!DV.SPL,D.STA2(R4) ;CLEAR DELETE AND SPOOL BITS 4$: RETURN 5$: BIS #DV.SAV,D.STA2(R4) ;MARK FOR SAVE RETURN .SBTTL ERR ; ERROR ; ; FUNDELETION 1$: MOVB F.LUN(R0),R2 ;GET LUN NUMBER JSR PC,$CLOSE ;CLOSE DOESN'T IF NO FILE OPEN MOV #-1,R1 ;SIGNAL ERROR RTS PC OKAY: CLR R1 ;SET SUCCESS SIGNAL RTS PC ;RETURN ;+ ; FUNCTION: ; CONSTRUCT DEFAULT FILE NAME IN FILE NAME BLOCK ; PORTION OF THE FDB. THE NAME IS OF THE FORM ; 'FOR0NN.DAT' WHERE NN IS THE LOGICAL UNIT NUMBER. ; ; INPUTS: ; R3 - WORK AREA POINTER ; ; OUTPUTS: ; NONE. ; ALL REGISTERS PRESERVED. ;- ; RADIX-50 CHARATER CODES USED HEREIN: R50.A ='A-10HASER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ;FIND DEVICE BLOCK (FDB) FOR GIVEN LUN NUMBER ;ALWAYS SET F.LUN WITH UNIT NUMBER ;ON ENTRY: ; R2 CONTAINS FORTRAN CH RTS PC .ENDC ;.IF DF MULDIV!FPU!FIS .SBTTL INTEGER AND OCTAL OUTPUT CONVERSIONS ;STACK ON ENTRY CONTAINS (IN REVERSE ORDER): ; RETURN PC ; NUMBER (2 WORDS IF F4P) ; FIELD WIDTH ; FIELD START ADDRESS .IF DF F4 OCO$: MOV #4,R0 ;SET R0 TO RADIX/2 BR IOGO ICO$: MOV #100005,R0 ;DITTO FOR DECIMAL BUT INCLUDE FLAG IOGO: MOV SP,R1 ADD #6,R1 ;R1 POINTS TO FIELD POINTER MOV @R1,R2 ;GET FIELD POINTER MOV (SP)+,@R1 ;SAVE CALLING PC IN SAFE PLACE MOV -(R1),R3 ;GET FIELD WIDTH CTION ; SET ERR= TRANSFER FOR CLOSE ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; ERR: MOV 2(R5),ERREX(R3) ;SET UP "ERR=" EXIT RETURN .SBTTL GET INTEGER PARAMETER VALUE ; GETVAL ; ; FUNCTION ; GET VALUE OF PARAMETER WHERE PARAMETER MAY BE ; INTEGER*2 VALUE (ARGTYP=1), ADDRESS OF INTEGER*2 ; VALUE (ARGTYP=2), OR ADDRESS OF INTEGER*4 ; VALUE (ARGTYP=3). ; ; INPUTS ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; CON0 R50.D ='D-100 R50.F ='F-100 R50.O ='O-100 R50.R ='R-100 R50.T ='T-100 R50.0 =36 $FLDEF:: JSR R5,.SAVR1 ;FCS REGISTER SAVE COROUTINE MOV FILPTR(R3),R4 ;GET DEVICE BLOCK POINTER MOVB F.LUN+D.FDB(R4),R2 ;GET LUN CLR R1 1$: SUB #10.,R2 BMI 2$ INC R1 BR 1$ 2$: ADD #10.,R2 ;LOW DIGIT IN R2 ;HIGH DIGIT IN R1 ADD #R50.0,R1 ;MAKE RAD50 DIGIT .IF DF EIS!FIS!FPP MUL #40.,R1 ;TIMES 40. .IFF MOV R1,R5 ASL R1 ASL R1 ADD R5,R1 ASL R1 ASL R1 ASL R1 .ENDCANNEL NUMBER ;RETURNS ADDR(DEVBLK) IN R0 OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION $FCHNL:: $AOTS ;WORK AREA ADDRESS TO R3 MOV R2,R1 ;CHECK FOR VALID CHANNEL BLE 5$ ;BRANCH IF CHANNEL LESS THAN 1 MOV W.DEV(R3),R0 ;GET ADDR OF DEVBLOCK TABLE CMP W.LUNS(R3),R2 ;ONLY ALLOW UP TO UNITS= NUMBER BGE 3$ ;BRANCH IF CHANNEL OK 1$: ERROR BADCHN ;INVALID LUN NUMBER SEC BR 4$ 2$: ADD #F.FDB,R0 ;POINT TO NEXT FDB 3$: SOB R1,2$ ;LOOP TILL NO MORE FDBS MOVB R2,F.LUN+D.FD MOV R5,@R1 ;SAVE R5 MOV -(R1),R5 ;GET NUMBER - R1 NOW EQUALS SP MOV R4,@R1 ;SAVE R4 ADD R3,R2 ;POINT TO END OF FIELD MOV R3,-(SP) ;SAVE FIELD LENGTH FOR ASTERISKING MOV #"- ,R1 ;SET SIGN PLUS (BLANK) TENTATIVELY ASL R0 ;GET DECIMAL FLAG BCC POS ;OCTAL OUTPUT IS UNSIGNED TST R5 ;DECIMAL OUTPUT IS SIGNED IF NEGATIVE BGE POS NEG R5 ;FORCE NUMBER POSITIVE SWAB R1 ;SET SIGN MINUS POS: CLRB R1 ;DO A 24-BIT DIVIDE OF THE RADIX CLR R4 ;INTO THE NUMBER. DIVIDEND IN R1 AND R5, DITION CODES OF HIGH ORDER VALUE ; R0 - LOW ORDER VALUE ; R1 - HIGH ORDER VALUE ; GETVAL: CMPB 1(R5),#1 ;IS IT A SIMPLE VALUE? BNE 1$ ;NO MOV 2(R5),R0 ;GET VALUE BR 2$ ; 1$: CMPB 1(R5),#2 ;IS IT ADDRESS OF I*2? BNE 3$ ;NO MOV @2(R5),R0 ;GET VALUE 2$: CLR R1 ;CLEAR HIGH ORDER RETURN 3$: MOV 2(R5),R1 ;GET ADDRESS OF I*4 VALUE MOV (R1)+,R0 ;GET LOW ORDER MOV (R1),R1 ;GET HIGH ORDER RETURN .END ;DF EIS!FIS!FPP ADD #,R1 ;RAD50 '0 0' ADD R2,R1 ;GIVES 2ND HALF OF FILE NAME MOV R1,N.FNAM+2+F.FNB+D.FDB(R4) ;PUT RAD50 'FOR' IN NAME FIELD MOV #<+R50.O>*40.+R50.R,N.FNAM+F.FNB+D.FDB(R4) ;PUT RAD50 'DAT' IN TYPE FIELD MOV #<+R50.A>*50+R50.T,N.FTYP+F.FNB+D.FDB(R4) RTS PC .END B(R0) ;INSERT LUN NUMBER CLC 4$: RTS PC ;RETURN ; ; MAP NEGATIVE LUN NUMBERS FROM IMPLIED UNIT ; I/O STATEMENTS INTO THE REAL LUN SPACE. ; 5$: BEQ 1$ ;ZERO IS ALWAYS AN ERROR NEG R2 ;MAKE POSITIVE CMP R2,W.LNMP(R3) ;WITHIN MAPPABLE RANGE? BGT 1$ ;BRANCH IF NOT ASL R2 ;MAKE UNIT INTO WORD OFFSET ADD R3,R2 ;GET RELATIVE BASE ADDRESS MOV W.LNMP(R2),R2 ;GET NEW UNIT NUMBER BLE 1$ ;DON'T ALLOW ERROR LOOP BR $FCHNL ;TRY AGAIN ; ; $GETFILE:: $AOTS TST FILPTR(R3) ;I/O COM R4 ;QUOTIENT WINDS UP IN R4 (COMPLEMENTED) 2$: ROL R5 ;AND REMAINDER IN R1 BCC 2$ BEQ ZERO ;HANDLE ZERO CASE DIVLP: ROLB R1 CMPB R1,R0 BLO 3$ ;IF WE BRANCH, CARRY IS SET SUB R0,R1 ;THIS CLEARS CARRY 3$: ROL R4 ASL R5 BNE DIVLP ZERO: COM R4 ;RECOMPLEMENT QUOTIENT DEC R3 ;ANY ROOM IN FIELD? BMI IOERR ;NO - FIELD OVERFLOW ADD #'0,R1 ;CONVERT QUOTIENT TO DIGIT MOVB R1,-(R2) ;STORE IT MOV R4,R5 ;SET UP FOR NEXT DIVISION BNE POS ;(IF THERE IS TO BE ONE) BR NOMODG .TITLE $FMTCV -FORMAT COMPILER FOR EXECUTION TIME IDENT 05 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE .TITLE $ENCDEC - ENCODE/DECODE IDENT 04 ;RFB 26-SEP-74 ; ; ;THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ;EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO ;RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. ; ;THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER ;UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE ;COPIED (WITH INCLUSION OF DIGITAL'S COPYRIGHIN PROGRESS? BEQ 1$ ;BRANCH IF NOT ERROR IOINIO ;RECURSIVE I/O 1$: JSR PC,$FCHNL ;GET I/O CONTROL BLOCK ADDR MOV R0,FILPTR(R3) ;SAVE FOR OTHERS TSTB @R0 ;RETURN N-BIT WITH OPEN STATUS RTS PC ; ; $IOEXIT:: $AOTS .IF DF FPP TSTB W.FPPF(R3) ;FPP PRESENT? BNE 1$ ;BRANCH IF NOT LDFPS W.FPST(R3) ;RESTORE FPP STATUS 1$: .ENDC ;DF FPP CLR ENDEX(R3) CLR FILPTR(R3) CLR ERREX(R3) MOV FMTCLN(R3),SP ;RESTORE STACK POINTER TO ENTRY LEVEL MOV R4,R0 ;TARGET ADDR JMP $SA ;NUMBER REDUCED TO 0 - NO MORE DIGITS SGNLP: SWAB R1 ;GET SIGN BYTE MOVB R1,-(R2) ;AND STORE IT MOV #" ,R1 ;AND RESET IT TO BLANK NOMODG: DEC R3 ;HERE WHEN DIGITS EXHAUSTED - ROOM FOR SIGN? BGE SGNLP ;YES - PUT IT OUT CMPB #'-,R1 ;NO - WAS SIGN NEGATIVE? BEQ IOERR ;YES - FIELD OVERFLOW TST (SP)+ ;POP BACKUP FIELD WIDTH QUICKY: MOV (SP)+,R4 ;RESTORE R5 MOV (SP)+,R5 ;AND R4 RTS PC ;AND RETURN ASTLP: MOVB #'*,(R2)+ ;SINCE FIELD OVERFLOWED, R2 POINTS IOERR: DEC @SP ;TO BEGINNINPURCHASER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER FOR FORTRAN IV-PLUS 3-AUG-74 ; 1. T, P FORMAT ENCODING CHANGED TO FACILITATE ; HANDLIT NOTICE) ;ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED ;IN WRITING BY DIGITAL. ; ;DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE ;OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED ;BY DIGITAL. ; ;COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION ; ;R. BRENDER 16-JUN-74 ; ;+ ;FUNCTION: ; PROCESS ENCODE AND DECODE STATEMENTS. ; ;METHOD: ; SET UP WORK AREA JUST LIKE I/O ; STATEMENT, THEN LET $FIO DO THE ; WORK. ; ;CALLING SEQUENVPX ;I/O CO-ROUTINE UNWIND .END G OF FIELD - THEREFORE BGE ASTLP ;USE IT AND THE BACKUP FIELD WIDTH QUICKX: COM (SP)+ ;ON THE STACK TO STORE ASTERISKS. BR QUICKY ;RETURN WITH CARRY ON TO SHOW ERROR .ENDC ;DF F4 .IF DF F4P OCO$: MOV #4,R0 ;SET R0 TO RADIX/2 BR IOGO ICO$: MOV #100005,R0 ;SAME FOR DECIMAL RADIS PLUS FLAG IOGO: MOV SP,R1 ADD #8.,R1 ;POINT TO FIELD START POINTER MOV @R1,R2 ;GET IT MOV (SP)+,@R1 ;PUT RETURN THERE MOV -(R1),R3 ;GET WIDTH MOV R4,@R1 ;SAVE R4 MOV -(R1),R4 ;GET HIGH ORDER VNG VARIABLE FORMAT EXPRESSIONS IN $FIO ; 2. : FORMAT SEPERATOR ADDED ; 3. INTERNAL FORMAT CODES CHANGED TO PROVIDE ; DEFAULT W.D SUPPORT OTSWA ERRDEF OTS$I ;PURE CODE SECTION .IF DF F4P FMTCV$:: JSR PC,$SAVP0 ;THE INPUT ARG WILL BE LEFT MOV R0,-(SP) ;AND MODIFIED SO SAVE ITS ADDRESS MOV @R0,R5 ;ADDRESS OF FORMAT TO COMPILE JSR PC,CV ;SIMPLIFIES THE CONDITIONALS MOV R0,@(SP)+ ;OVER-WRITE INPUT ARG RTS PC .ENDC ;DF F4P .IF DF F4 $OBJFMT:: MOV R5,-(SP) ;SAVCE: ; ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,ENF(E)$ (FOR ENCODE) ; OR ; JSR PC,DEF(E)$ (FOR DECODE) ; ; RETURNS WITH ALL ARGUMENTS DELETED, CONTEXT ; PRESERVED, AND READY FOR ELEMENT TRANSMISSION. ; ;- OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION ENF$:: JSR PC,$SAVP3 MOV #FL.FMT!FL.ENC,R1 BR ENF ENFE$:: JSR PC,$SAVP5 MOV #FL.FMT!FL.ERR!FL.ENC,R1 ENF .TITLE $INITIP - COMMON I/O STATMENT INIT ROUTINE IDENT 07 ;RFB 25-SEP-74 ; ; ;THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ;EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO ;RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. ; ;THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER ;UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE ;COPIED (WITH INCLUSION OFALUE MOV R5,@R1 ;SAVE R5 THERE MOV (SP)+,R5 ;GET LOW ORDER VALUE ADD R3,R2 ;POINT TO END OF FIELD+1 MOV R3,-(SP) ;SAVE WIDTH FOR LATER MOV #" -,-(SP) ;SET INITIAL SIGN AS PLUS ASL R0 ;SIGNED INPUT FLAG? BCC POS ;BRANCH IF OCTAL TST R4 ;IS VALUE NEGATIVE? BGE POS ;BRANCH IF POSITIVE NEG R4 ;MAKE + VALUE NEG R5 SBC R4 SWAB @SP ;SET OUTPUT SIGN TO MINUS POS: ; ; DIVIDE R4,R5 BY R0 (WHICH IS 8 OR 10) LEAVING ; QUOTIENT IN R4,R5 AND REMAINDER IN R1 ; .IF DF FPP!FIS!E SOME REGS MOV R4,-(SP) MOV R0,R5 ;R0 CONTAINS ADDR OF STRING TO COMPILE JSR PC,CV MOV (SP)+,R4 MOV (SP)+,R5 RTS PC .ENDC ;DF F4 CV: $AOTS ;INIT WORK AREA POINTER MOV W.OBFL(R3),FMTAD(R3) ;COMPILE FORMAT STRING INTO HERE 1$: CMPB #' ,(R5)+ ;IGNORE LEADING BLANKS BEQ 1$ ;BRANCH TO SKIP BLANKS CMPB -1(R5),#'( ;MUST START WITH A LEFT PAREN BNE ERR1 ;SYNTAX ERROR CLR NOARG(R3) ;NUMBER OF EXPECTED ARGS CLR PARLVL(R3) ;PARENTHESIS LEVEL FMLOOP: CLR NUMFLG(R3) ;NO NUMBER : JSR PC,$INITIO MOV #WRITE,R1 BR COMMON DEF$:: JSR PC,$SAVP3 MOV #FL.FMT!FL.ENC,R1 BR DEF DEFE$:: JSR PC,$SAVP5 MOV #FL.FMT!FL.ENC!FL.ERR,R1 DEF: JSR PC,$INITIO MOV #READ,R1 COMMON: MOV #REDWRT,RECIO(R3) MOV R1,FILPTR(R3) JMP $FIO REDWRT: RTS PC ;DUMMY READ/WRITE ROUTINE OTS$D ;PURE DATA SECTION READ: .WORD 0,0 ;PARTIAL DEVICE CONTROL BLOCKS WRITE: .WORD DV.RW,0 .END DIGITAL'S COPYRIGHT NOTICE) ;ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED ;IN WRITING BY DIGITAL. ; ;DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE ;OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED ;BY DIGITAL. ; ;COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION ; ;R. BRENDER 16-JUN-74 ; ;+ ;FUNCTION: ; CALLED BY ALL I/O INIT ROUTINES TO SET UP ; THE WORK AREA FROM THE CALLING ARGS, ; COMPLETE FPP CONTEXT MANAGEMENT, AND ; OTHEEIS MOV R5,R1 ;SAVE FOR NOW MOV R4,R5 ;HIGH ORDER DIVIDEND CLR R4 DIV R0,R4 MOV R4,-(SP) ;SAVE HIGH ORDER QUOTIENT MOV R5,R4 ;SET UP LOW ORDER DIVIDE MOV R1,R5 ASL R0 ;SCALE BY 2 TO KEEP NEXT QUOTIENT ;OUT OF BIT 15 DIV R0,R4 MOV R4,-(SP) ;FUNNY LOW ORDER QUOTIENT CLR R4 ;NOW HAVE REMAINDER MOD 120 OR 16 ASR R0 ;SCALE BACK DIV R0,R4 ;LAST TIME MOV R5,R1 ;THE REAL REMAINDER MOV (SP)+,R5 ;FIX UP LOW QUOTIENT BY ASL R5 ;PUT LAST BIT IN ADD R4,R5 ;WHERE IT BAVAILABLE CLR R2 ;CLEAR NUMBER ACCUMULATOR CLR R4 ;OVERFLOW INDICATOR JSR PC,FLOOP ;PROCESS NEXT PIECE OF FORMAT BR FMLOOP ; ; PROCESS ONE FORMAT ITEM ; .ENABL LSB FLOOP: MOVB (R5)+,R0 ;GET NEXT CHAR CMPB #' ,R0 ;IGNORE BLANKS BEQ FLOOP ;BRANCH IF BLANK CMPB R0,#'Z ;IS CHAR IN ALPHA RANGE? BGT NOALPH ;BRANCH IF NOT ALPHA CMPB R0,#'A-1 ;ALPHABETIC? BGT 1$ ;YES, RETURN CHAR NOALPH: CMPB R0,#'0 ;NUMERIC OR SPECIAL? BLT 2$ ;RETURN SPECIAL CHAR CMPB #'9,R0 ;NUMERIC? .TITLE $OPNSTM -OPEN STATEMENT SUPPORT IDENT 33 ;RFB 30-SEP-74 ; ; COPYRIGHT 1974, ; DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMIT- ; MENT BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UNDER A LICENSE FOR UR DETAILS. ; ;CALLING SEQUENCE: ; JSR PC,$INITIO ; ;INPUTS: ; R0 = STACK ADDR OF LAST ARG (FROM $SAVP(N)) ; R1 = BIT MASK OF ARGS PRESENT ; BIT 15 = 1 => END=/ERR=ADDRESSES ; BIT 14 = 1 => ENCODE/DECODE CHAR ARRAY ADDRESS ; BIT 13 = 1 => FORMAT ADDRESS ; BIT 12 = 1 => RANDOM ACCESS RECORD NUMBER (I*4) ; BIT 11 = 1 => DO ENCODE/DECODE SETUP ; = 0 => DO NORMAL I/O SETUP ; BIT 10 = 1 => DEFINE FILE NEEDED ; BIT 9 = 1 => FORMATTED ONLY ; = 0 => UNFORMATTED ELONGS MOV (SP)+,R4 ;DONE! .IFF .ERROR ;NOT IMPLEMENTED WITHOUT DIV INSTRUCTION .ENDC ; ADD #'0,R1 ;MAKE REMAINDER A CHAR MOVB R1,-(R2) ;PLACE IN OUTPUT TST R4 ;MORE TO DO? BNE 1$ ;BRANCH IF SO TST R5 ;LOOK HARDER BEQ NOMODG ;BRANCH IF REALLY NO MORE 1$: SOB R3,POS ;LOOP IF STILL ROOM IN FIELD ; ; FIELD OVERFLOW ; IOERR: MOV 2(SP),R3 ;RESTORE WIDTH 2$: MOVB #'*,(R2)+ ;FILL WITH STARS SOB R3,2$ QUICKY: CMP (SP)+,(SP)+ ;DISCARD SIGN AND FIELD WIDTH SEC ;SET ERROR BLT 2$ ;NO, RETURN SPECIAL SUB #'0,R0 ;NUMERIC, GET VALUE ASL R2 ;R2 = R2 * 10 + NEW_DIGIT ADD R2,R0 ASL R2 ASL R2 ADD R0,R2 BIS R2,R4 ;LOOKING FOR OVERFLOW INC NUMFLG(R3) ;INDICATE A NUMBER IS AVAILABLE FOR USE BR FLOOP 1$: ASL R0 ;MAKE A WORD INDEX MOV FLTBL-<2*'A>(R0),R0 ;GET CODE FOR FORMAT LETTER MOV R0,R1 BIC #177600,R0 ;ISOLATE FORMAT CODE CLRB R1 SWAB R1 ;ISOLATE RELATIVE JUMP ADDRESS JMP FLTBL(R1) ;AND GO TO APPROPRIATE ROUTINE ; SPECIAL CHAR: 2$: MOV #FCHSE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL EQUIPMENT CORPORATION. ; ; D. KNIGHT 08/19/74 ; ; GENERAL PURPOSE OTS "OPEN" STATEMENT PROCESSOR ; ; NOTE: WITHIN THE ROUTINES OF THE OPEN PROCESSOR, REGONLY ; BIT 8 = 1 => WRITE OPERATION ; = 0 => READ OPERATION ; BIT 7 = 1 => DO OPEN IF NOT OPEN ; ;OUTPUTS: ; R2,R5= UNCHANGED ; R0 = DEVICE TABLE ADDRESS ; R1 = DESTROYED ; R3 = WORK AREA ADDRESS ; R4 = CONTINUATION ADDRESS FOR DOING FIRST ELEMENT TRANSMISSION ; ; ;COMMON SYMBOLS: ; THE I/O ROUTINES USE THE FOLLOWING SYMBOLS ; TO INDICATE DESIRED PROCESSING: ; ; FL.ERR => END=/ERR=ADDRESSES PRESENT ; FL.ENC => SPECIAL HANDLING FOR ENCODE/DECODE ; FL.FMT => FCONDITION FOR CALLER QUICKX: MOV (SP)+,R5 MOV (SP)+,R4 RTS PC ; ; FINISH UP BY HANDLING SIGN ; NOMODG: DEC R3 ;ROOM FOR SIGN? BEQ 1$ ;BRANCH IF NOT MOVB @SP,-(R2) ;PUT IN SIGN MOVB #' ,@SP ;REPLACE SIGN WITH BLANK BR NOMODG ;LOOP TO BLANK FILL REST 1$: CMPB #'-,@SP ;FIELD FULL - DOES SIGN REMAIN? BEQ IOERR ;BRANCH IF SO - ERROR CMP (SP)+,(SP)+ ;ALL IS FINE CLC ;SET SUCCESS CONDITION FOR CALLER BR QUICKX .ENDC ;DF F4P .SBTTL REAL AND DOUBLE OUTPUT CONVERSIONS ARS,R1 ;POINT TO LIST OF SPECIAL CHARS CMPB R0,-(R1) ;COMMA? BEQ 3$ CMPB R0,-(R1) ;PERIOD? BEQ 5$ CMPB R0,-(R1) ;SLASH? BEQ 6$ CMPB R0,-(R1) ;LEFT PAREN? BEQ 8$ CMPB R0,-(R1) ;RIGHT PAREN? BEQ 10$ CMPB R0,-(R1) ;QUOTE? BEQ 13$ CMPB R0,-(R1) ;DOLLAR SIGN? BEQ 11$ CMPB R0,-(R1) ;COLON? BEQ 17$ CMPB R0,-(R1) ;MINUS? BNE ERR ;SYNTAX ERROR BIS #100000,NUMFLG(R3) ;SET NEGATIVE BR FLOOP ; COMMA PRCOM: 3$: DEC NOARG(R3) ;NUMBER OF ARGS SHOULD BE 0 OR 1 BNE 7$ 4$: TISTERS ; 0, 1, AND 2 ARE ALWAYS CONSIDERED SCRATCH AND NEED NOT BE SAVED OR ; RESTORED. REGISTER 3 CONTAINS THE ADDRESS OF THE WORK AREA. ; REGISTER 4 CONTAINS THE LUN BLOCK POINTER AS SET UP BY "UNIT." ; REGISTER 5 IS USED AS THE ARGUMENT POINTER AND IS ADVANCED ; AS REQUIRED. ; ; MACRO PROTOTYPES .MCALL CALL,RETURN ; DATA AREA AND FIELD DEFINITIONS OTSWA FBLOCK ERRDEF ; W.OPFL CONTAINS THE ERROR COUNT ACCUMULATED DURING OPEN. ; IF IT IS SET TO NEGATIVE IT IS A CATASTROPHIC EORMAT PRESENT ; FL.REC => RANDOM ACCESS RECORD NUMBER PRESENT ; FL.WRT => WRITE OPERATION (OPEN IF NEEDED) ; FL.RD => READ OPERATION (OPEN IF NEEDED) ; ; THESE SYMBOLS ARE DEFINED IN THE COMMON PREFIX ; FILE F4P.MAC. SINCE THESE SYMBOLS ARE IN EFFECT ; A BIT MICRO-ENCODING, SPECIAL CARE IS REQUIRED ; IF MODIFYING THIS ROUTINE. ; ;- OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION $INITIO:: $AOTS TST FILPTR(R3) ;RECURSIVE I/O? BEQ 1$ ;CONTINUE IF NOT ERROR IOINIO ;ALWAYS ;DEFINITIONS OF STACK OFFSET VARIABLES: OSIGN= 2. ;0 IF NUMBER POSITIVE, -1 IF NEGATIVE OFLAGS= 4. ;EXPONENT LETTER PLUS CONVERSION-CONTROLLING FLAGS OP= 12. ;SCALE FACTOR OD= 14. ;PLACES AFTER DECIMAL POINT OLEN= 16. ;OUTPUT FIELD WIDTH OFIELD= 18. ;OUTPUT FIELD POINTER ;STACK ON ENTRY CONTAINS (IN REVERSE ORDER): ; RETURN PC ; 4 WORDS OF FLOATING POINT NUMBER (HIGH ORDER FIRST) ; P FACTOR ; D FACTOR ; FIELD WIDTH ; FIELD START ADDRESS GCO$: MOV #42437,R2 ;"E" EXP AND ALL FLAGST NUMFLG(R3) ;IS A NUMBER AVAILABLE? BLE ERR ;SYNTAX ERROR SWAB R4 ;HIGH BYTE MUST HAVE BEEN ZERO BNE ERR ;NUMBER OUT OF RANGE MOV R2,R0 ;ARG TO OBJBYT BR OBJBYT 7$: BGT ERR ;SYNTAX CLR NOARG(R3) TST NUMFLG(R3) ;IS A NUMBER AVAILABLE? BNE ERR ;SYNTAX ERROR RTS PC ; PERIOD 5$: DEC NOARG(R3) ;(DOT) NOARG SHOULD BE 2 BPL 4$ ;OKAY ERR1: BR ERR ;SYNTAX ; SLASH 6$: JSR PC,ENDLST ;(SLASH) MOVB #SLASH,R0 BR OBJBYT ; DOLLAR SIGN 11$: JSR PC,ENDLST MOVB #DOLLAR,R0 ;CRROR WHICH WILL ; IMMEDIATELY ABORT PROCESSING AND TAKE THE "ERR=" EXIT IF ANY. .SBTTL OPEN KEYWORD DISPATCH ; OPEN$ ; ; FUNCTION ; OPEN$ IS THE TOP LEVEL PROCESSOR FOR THE OPEN STATEMENT. ; IT SEQUENCES THROUGH EACH ARGUMENT AND CALLS THE PROCESSING ; ROUTINE FOR THAT ARGUMENT. ; ; INPUTS ; R5 - ADDRESS OF ARGUMENT LIST AS SPECIFIED IN ; 130-950-082-XX. ; ; OUTPUTS ; VALUE - NONE. ; OTS$I OPEN$:: $AOTS ;PLACE ADDRESS OF WORK AREA IN R3 MOVB #-1,W.IOEF(R3) ;SET EFATAL! 1$: CLR DENCWD(R3) ;DEFAULT IS ALLOW MULTIPLE RECORDS .IF DF F4 MOV R4,-(SP) ;PRESERVE THREADED POINTER MOV SP,R0 ;COMPUTE STACK VALUE ADD #10.,R0 ;FOR END=/ERR=EXIT MOV R0,FMTCLN(R3) ;AND SAVE IT SUB #6,R0 ;TO LAST ARGUMENT MOV R1,R4 ;PUT BIT MASK IN R4 ROL R4 ;IGNORE END=/ERR=BIT .ENDC ;DF F4 .IF DF F4P MOV R5,W.R5(R3) ;SAVE CODE LEVEL R5 FOR USE BY ;$FIO DURING VAR FMT EXPS MOV SP,R4 ;GET STACK FOR END=/ERR= ACTION TST (R4)+ ;MOVE PAST LAST PC MOVS ON BR XCO FCO$: CLR R2 ;NO EXP AND NO FLAGS BR XCO ECO$: MOV #42431,R2 ;"E" EXP AND SOME FLAGS ON BR XCO DCO$: MOV #42031,R2 ;"D" EXP AND SAME FLAGS AS "E" XCO: MOV SP,R3 TST (R3)+ ;R3 NOW POINTS TO NUMBER TO BE OUTPUT MOV (R3)+,R0 ;GET HIGH ORDER MOV (R3)+,R1 ;NEXT MOV R4,-(SP) ;SAVE R4 AND R5 MOV R5,-(SP) MOV (R3)+,R4 ;LOAD THEM WITH LOW ORDER NUMBER MOV (R3)+,R5 MOV (SP)+,-(R3) ;NOW RESAVE THEM OVER THE NUMBER MOV (SP)+,-(R3) MOV (SP)+,-(R3) ;RESAVE THE PC ALSO MOV RODE FOR DOLLAR SIGN BR OBJBYT ;OUTPUT IT ; COLON 17$: JSR PC,ENDLST MOVB #COLON,R0 BR OBJBYT ; LEFT PAREN 8$: TST PARLVL(R3) ;TOP LEVEL? BNE 9$ ;NO MOVB #TPLVL,R0 JSR PC,OBJBYT 9$: INC PARLVL(R3) CMP PARLVL(R3),#8. BHI ERR ;ERROR,NESTING MOVB #LPAREN,R0 BR FREPT ;GO PROCESS A REPT COUNT IF ANY ; RIGHT PAREN 10$: JSR PC,ENDLST ;(RIGHT PAREN) DEC PARLVL(R3) BMI 12$ ;BRANCH IF END OF FORMAT TEXT MOVB #RPAREN,R0 BR OBJBYT ; END OF FORMAT PROCESSING 12$: TST (SPRROR RETURN FLAG CLR W.OPFL(R3) ;SET NULL ERROR COUNT TST FILPTR(R3) ;IS I/O CURRENTLY IN PROGRESS? BEQ 1$ ;NO ERROR IOINIO ;RECURSIVE I/O CALL INC W.OPFL(R3) ;SET NO CONTINUE BR 5$ 1$: MOV (R5)+,-(SP) ;GET THE ARGUMENT COUNT TIMES TWO ASR (SP) ;GET THE ACTUAL ARGUMENT COUNT 2$: MOVB (R5),R0 ;GET THE ENCODED KEYWORD DEC R0 ;CONVERT IT TO A WORD ASL R0 ; INDEX TST W.OPFL(R3) ;IS THIS A CATASTROPHIC ERROR? BPL 3$ ;NO CMP R0,#ERRPT-DISPAT ;IS THIS THE "ERR=" ARGUMENT? BN R4,FMTCLN(R3) ;AND SAVE IT MOV R1,R4 ;PUT BIT MASK IN R4 .IF DF FPP TSTB W.FPPF(R3) ;FPP PRESENT? BNE 21$ ;BRANCH IF NOT STFPS W.FPST(R3) ;FPP STATUS FOR END=/ERR= 21$: .ENDC CLR R1 ;DEFAULT ERR=ADDRESS CLR R2 ;DEFAULT END=ADDRESS ROL R4 ;BIT 15 - END=/ERR=PRESENT? BCC 2$ ;BRANCH IF NO MOV (R0)+,R1 ;FETCH ERR= MOV (R0)+,R2 ;FETCH END= 2$: MOV R1,ERREX(R3) ;SAVE IN WORK AREA MOV R2,ENDEX(R3) .ENDC ;DF F4P ROL R4 ;BIT 14 - ENCODE/DECODE? BCC 3$ MOV @R0,B2,@SP ;SAVE FLAGS JUST BELOW PC CLR -(SP) ;CLEAR SIGN ROL R0 ;GET SIGN OF NUMBER SBC @SP ;SET SIGN WORD TO -1 IF NUM NEGATIVE CLR -(SP) ;CLEAR SCALE FACTOR ASRB R2 ;TEST E, D OR G FORMAT BCC 2$ ;NO SUB #4,OLEN(SP) ;YES - REDUCE WIDTH BY 4 FOR EXPONENT 2$: TST R0 ;CHECK NUMBR TO BE OUTPUT BNE NOTZRO ;NON-ZERO ROR R2 ;IF ITS ZERO, WE CAN SKIP MOVB R2,OFLAGS(SP) ;AN AWFUL LOT OF CODE BR TSTG NOTZRO: SEC ;INSERT NORMALIZE BIT RORB R0 ;INTO NUMBER MOV R0,-(SP) ;SAVE HI)+ ;POP LAST RETURN ADDR MOVB #EOFMT,R0 JSR PC,OBJBYT EXIT: MOV W.OBFL(R3),R0 ;ADDRESS OF COMPILED FORMAT RTS PC ;RETURN TO CALLER ; QUOTE - ALTHOUGH THIS LOOKS LIKE H FORMAT NOTE THAT A READ INTO ; THE QUOTED STRING ONLY MODIFIES THE STRING FOR THAT READ, IN OTHER ; WORDS THE ARRAY IS NOT MODIFIED BY THE READ... 13$: JSR PC,ENDLST ;END LAST SPEC IF ANY .DSABL LSB Q: MOV R5,-(SP) ;REMEMBER TEXT PTR. CLR R2 ;WILL BE CHAR COUNT 14$: INC R2 ;COUNT CHARS CMPB (R5)+,@R1 ;QUOTE? BNE 1E 4$ ;NO, DON'T PROCESS ANY OTHER FORM WITH THIS ;ERROR SET 3$: CALL @DISPAT(R0) ;GO TO THE PROPER PROCESSOR 4$: ADD #4,R5 ;ADVANCE TO NEXT ARGUMENT DEC (SP) ;DECREMENT ARGUMENT COUNT BGT 2$ ;LOOP UNTIL COMPLETE TST (SP)+ ;CLEAN UP THE STACK TST W.OPFL(R3) ;CATASTROPHIC ERROR? BPL 5$ ;NO JMP ERJMP ;YES, IMMEDIATELY SUSPEND PROCESSING 5$: JMP OPEN ;DO THE ACTUAL OPEN ; DISPATCH TABLE FOR OPEN KEYWORD PROCESSOR. OTS$D DISPAT: UNIT ;UNIT - 1 DISPOS ;DISPOSE - 2 ELBUF(R3) ;MAKE INTERNAL BUFFER MOV @R0,LNBUF(R3) ;POINTERS USE USER ARRAY MOV (R0)+,EOLBUF(R3);(COUNT ADDED IN LATER) MOV #1,DENCWD(R3) ;DISALLOW MULTIPLE RECORDS ; 3$: ROL R4 ;BIT 13 - FORMAT? BCC 4$ MOV (R0)+,FMTAD(R3) ;SAVE IT ; 4$: ROL R4 ;BIT 12 - RECORD NUMBER? BCC 5$ MOV #1,DENCWD(R3) ;DISALLOW MULTIPLE RECORDS MOV (R0)+,W.RECL(R3);SAVE LOW ORDER PART .IF DF F4P MOV (R0)+,W.RECH(R3);ALSO HIGH ORDER PART .ENDC ; 5$: ROL R4 ;BIT 11 - ENCODE/DECODE? BCC 6$ ADGH ORDER WORD CLRB @SP ;ISOLATE EXPONENT BIC @SP,R0 ;CLEAR EXPONENT FROM R0 SWAB @SP ;GET EXPONENT ON STACK INTO LOW-ORDER JSR PC,NORM ;NORMALIZE R0,R1,R4,R5 TO BIT 59. MOV (SP)+,R2 ;GET EXPONENT FROM STACK SUB #200,R2 ;REMOVE BIAS BGT GT1 ;NUMBER IS .GT. 1.0 - SCALE IT DOWN SCALUP: JSR PC,MUL5 ;NUMBER LESS THAN 1.0 - JSR PC,NORM ;SCALE IT UP UNTIL IT IS GREATER DEC @SP ;THAN 1.0, INC R2 ;THEN FALL INTO "GT1" TO BLE SCALUP ;SCALE IT BACK DOWN (BITS TO BURN!) GT1: JSR PC,4$ ;NO CMPB (R5)+,@R1 ;TWO IN A ROW? BEQ 14$ ;YES-COUNT AS ONE MOV (SP)+,R5 DEC R2 MOVB #HCODE,R0 JSR PC,FREPT1 BR 16$ 15$: JSR PC,OBJBYT 16$: MOVB (R5)+,R0 CMPB R0,@R1 ;QUOTE? BNE 15$ CMPB R0,(R5)+ ;TWO? BEQ 15$ DEC R5 RTS PC ERR: MOVB #FMTBAD,@W.OBFL(R3) ;SET BAD SYNTAX AS FORMAT CODE BR EXIT ENDLST: TST NUMFLG(R3) BEQ 1$ JSR PC,PRCOM 1$: TST NOARG(R3) BNE ERR ;SYNTAX RET: RTS PC FREPT: TST NUMFLG(R3) ;NUMBER AVAILABLE? BGT FREPT1 ;YES, USE IT BLT ERRPT: ERR ;ERR - 3 ACCESS ;ACCESS - 4 FORMAT ;FORM - 5 RECSIZ ;RECORDSIZE - 6 CARCON ;CARRIAGECONTROL - 7 RDONLY ;READONLY - 8 BUFCNT ;BUFFERCOUNT - 9 INITSZ ;INITIALSIZE - 10 EXTEND ;EXTENDSIZE - 11 NOSPAN ;NOSPANBLOCKS - 12 SHARED ;SHARED - 13 NAME ;NAME - 14 TYPECD ;TYPE - 15 MAXREC ;MAXREC - 16 ASSOCV ;ASSOCIATE VARIABLE - 17 OTS$I .SBTTL UNIT ; UNIT ; ; FUNCTION ; SET UP LUN IN THE DEVICE BLOCK AND SAVE DEVICE ; BLOCK ADDRESSD (R0)+,EOLBUF(R3);ADD IN RECORD LENGTH BR 14$ ; 6$: .IF DF F4 MOV (SP)+,R1 MOV @SP,-(R0) MOV R0,SP MOV R1,-(SP) .ENDC ;DF F4 MOV (R0)+,R2 ;UNIT NUMBER JSR PC,$FCHNL MOV R0,FILPTR(R3) ; ROL R4 ;BIT 10 - DEFILE FILE NEEDED? BCC 7$ BIT #DV.DFD,@R0 ;TEST DEFINE FILE DONE BIT BNE 7$ ;BRANCH IF DONE ERROR MIXFUF ;MIXED RANDOM/SEQUENTIAL ; 7$: ROL R4 ;BIT 9 - FORMATTED? BCC 8$ ;BRANCH IF NOT BIT #DV.UFP,@R0 ;UNFORMATTED NOT PERMITTED? BNE 9$ ;BRANCH IF IS -DIV10 ;DIVIDE MANTISSA BY 10 INC @SP ;BUMPING SCALE FACTOR JSR PC,NORM ;AND KEEPING NUMBER NORMALIZED TST R2 ;UNTIL IT IS LESS THAN 1.0 BGT GT1 BEQ 9$ ;NOW UNNORMALIZE THE NUMBER 1$: JSR PC,RIGHTC ;SO THAT THE BINARY EXPONENT INC R2 ;IS ZERO BNE 1$ ;(SO THAT WE CAN THROW IT AWAY) 9$: MOV OD(SP),R2 ;COMPUTE WHICH PLACE TO ROUND RORB OFLAGS(SP) ;IF THE FORMAT IS E,D OR G BCS 2$ ;THE SCALE FACTOR DOES NOT APPLY HERE ADD @SP,R2 ;OTHERWISE IT ADDS (SUBTRACTS) TO "D". 2$: RORB OFLRR ;SYNTAX INC R2 ;USE ONE FREPT1: TST NOARG(R3) BNE ERR ;SYNTAX SWAB R4 ;TEST FOR OVERFLOW BNE ERR ;ERROR - REPEAT COUNT TOO LARGE DEC R2 ;DECREMENT NUMBER BEQ OBJBYT ;DONE BMI ERR ;ERROR-NUMBER OUT OF RANGE FREPT2: BIS #200,R0 ;SET COUNT INDICATOR FREPT3: JSR PC,OBJBYT MOV R2,R0 ;FALL INTO OBJBYT ;ACCEPT A BYTE TO BE OUTPUT FROM R0 OBJBYT: MOVB R0,@FMTAD(R3) ;STORE BYTE IN WORK SPACE INC FMTAD(R3) ;BUMP UP WORK SPACE POINTER CMP FMTAD(R3),W.OBFH(R3) ;ARE WE OUT OF FR. THIS ROUTINE MUST ALWAYS BE THE ; FIRST CALLED. ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R4 - ADDRESS OF DEFAULT FILE NAME BLOCK ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; R4 - LUN POINTER ; UNIT: CALL GETVAL ;GET THE PARAMETER VALUE INTO R0 AND R1 BNE 2$ ;JUMP IF LUN IS TOO LARGE MOV R0,R2 CMP R0,W.LUNS(R3) ;IS IT A LEGAL LUN POINTER? BGT 2$ ;NO CALL $FCHNL ;GET THE LUN POINTER INTO R0 MOV R0,R4 ;PUT AWAY THE LUN POINTER FOR LATER USE MOV R0,FILPTR(R3) ;SET UP TH ERROR BIS #DV.FMP,@R0 ;SET FORMATTED PERMITTED ; ; SPECIAL CASE CHECK: ; IF UNIT IS OPEN, AND THIS IS A SEQUENTIAL WRITE, AND ; PREVIOUS OPERATION WAS A READ, THEN FORCE USE OF THE ; USER RECORD BUFFER. ; 15$: TSTB @R0 ;UNIT OPEN? BPL 10$ ;BRANCH ON IF NOT TST R4 ;IS THIS A WRITE? BPL 10$ ;BRANCH IF NOT BIT #DV.DFD,@R0 ;SEQUENTIAL? BNE 10$ ;BRANCH IF NO TST @R0 ;LAST OP A READ? BMI 10$ ;ONWARD IF NOT MOV F.URBD+2+D.FDB(R0),F.NRBD+2+D.FDB(R0) BR 10$ ; 8$: BIT #DAGS(SP) ;UNLESS THE FORMAT SPECIFIED WAS BCC 3$ ;G FORMAT, AND THE CMP @SP,R2 ;NUMBER IS IN THE RANGE WHERE IT WILL PRINT AS BLOS 4$ ;F FORMAT, THE SCALE FACTOR 3$: ADD OP(SP),R2 ;ALSO AFFECTS THIS QUANTITY. 4$: TST R2 ;IF THIS QUANTITY IS NEGATIVE THERE IS NO BMI TSTG ;USE ROUNDING AS THERE ARE NO JSR PC,ROUND ;SIGNIFICANT DIGITS - ELSE ROUND. CMP R0,#10000 ;IF THE ROUNDING OPERATION HAS BLO TSTG ;SUPERNORMALIZED THE NUMBER, JSR PC,DIV10 ;WE MUST RESCALE IT DOWN BY 10 INC @SP ;EE SPACE BLO RET ;BRANCH IF STILL MORE ROOM MOVB #FMTBIG,@W.OBFL(R3) ;SET FORMAT TOO BIG AS FORMAT CODE BR EXIT OTS$D ;PURE DATA SECTION ; ; FORMAT CODE DEFINITIONS AND CONTROL TABLES ; ; SPECIAL CHARS: .ASCII "-:$')(/.," FCHARS: .EVEN ; INITIAL FORMAT CODES: FMTBAD =0 ;SYNTAX ERROR IN FORMAT FMTBIG =2 ;FORMAT OVERFLOWED BUFFER TPLVL =4 ;TOP LEVEL PAREN (FOR FORMAT REVERSION) LPAREN =6 ;LEFT PAREN RPAREN =10 ;RIGHT PAREN EOFMT =12 ;END OF FORMAT SLASH =14 ;RECORE FILE POINTER BIT #DV.DFD!DV.FACC!DV.ASGN,(R4) ;HAS DEFINE FILE, FDBSET ;OR ASSIGN ALREADY BEEN DONE? BNE 2$ ;YES, ERROR TSTB (R0) ;IS THE FILE ALREADY OPEN? BMI 1$ ;YES BIS #DV.NEW,D.STA2(R0) ;DEFAULT IS NEW FILE RETURN 1$: ERROR DEFOPN ;FILE ALREADY OPEN BR 3$ ;VERY BAD ERROR 2$: ERROR BADCHN ;VERY LARGE LUN NUMBER 3$: BIS #100000,W.OPFL(R3) ;SET CATASTROPHIC ERROR RETURN .SBTTL NAME ; NAME ; ; FUNCTION ; GENERATE FNB ENTRY FOR FILE NAME SPEC ; ; INPUTS ;V.FMP,@R0 ;FORMATTED NOT PERMITTED? BEQ 11$ ;BRANCH IF NOT - OKAY 9$: ERROR MIXFUF ;MIXED FORMATTED/UNFORMATTED 11$: BIS #DV.UFP,@R0 ;SET UNFORMATTED PERMITTED BR 15$ ;GO MAKE SPECIAL CHECK ; 10$: BIC #DV.RW,@R0 ;SET READ OP IN DEVICE TABLE ROL R4 ;BIT 8 - WRITE OPERATION? BCC 12$ ;BRANCH IF NOT BIT #DV.RDO,D.STA2(R0) ;READ ONLY FILE? BEQ 16$ ;BRANCH IF NOT ERROR ERWRDO ;WRITE TO READONLY FILE 16$: BIS #DV.RW,@R0 ;DECLARE WRITE ; 12$: ROL R4 ;BIT 7 - OPEN DESIRED? BCC 13$ ;AND BUMP THE SCALE FACTOR AGAIN. TSTG: MOV OP(SP),R2 ASRB OFLAGS(SP) ;CHECK FOR G FORMAT BCC NOTG ;JUMP IF NOT G CMP @SP,OD(SP) ;NOW WE DECIDE WHETHER G FORMAT PRINTS BHI NOTG ;AS F OR E FORMAT, DEPENDING ON SCALE SUB @SP,OD(SP) ;FACTOR. IF WE PRINT AS F, WE DECREASE THE CLR R2 ;NUMBER OF POST-D.P. DIGITS BY THE CLR OP(SP) ;NUMBER OF PRE-D.P. DIGITSI ;AND CLEAR THE SCALE FACTOR. MOV #336,OFLAGS(SP) ;SET THE FLAGS TO INDICATE E FORMAT ;UNTIL THE LAST MINUTE WHEN THEY ;WD TERMINATOR DOLLAR =16 ;SPECIAL TERMINAL CARRIAGE CONTROL COLON =20 ;COLON CODE =COLON ;USED BY FOLLOWING MACROS ; MACRO TO DEFINE FORMAT CONVERSIONS: .MACRO FCDE CHAR,RTN T=2*<''CHAR-'A> .=FLTBL+T CODE= CODE+2 .BYTE CODE,RTN-FLTBL CHAR'CODE=CODE .ENDM FLTBL: .REPT 26. .BYTE 0,ERR-FLTBL .ENDR ; FORMAT LETTER TABLE (ONE ENTRY FOR EACH FORMAT CODE LETTER): ; CODES ARE ASSIGNED IN ORDER OF OCCURRANCE. ENTRIES ; MAY BE ADDED IN ANY ORDER. ONE ENTRY PER LETTER, PLEASE. ; R3 - ADDRESS OF WORK AREA ; R4 - ADDRESS OF DEVICE BLOCK ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; NAME: MOV 2(R5),R1 ;GET ADDRESS OF STRING MOV R1,R2 ;GET A COPY OF IT 1$: TSTB (R2)+ ;COUNT THE LENGTH BNE 1$ ;OF SUB R1,R2 ;THE DEC R2 ;STRING BEQ 2$ ;ERROR IF IT IS ZERO LENGTH MOV R4,R0 ;PUT LUN POINTER IN R0 FOR FILE SET UP CALL $FNBST ;NOW GO SET UP THE FILE NAME BLOCK BCS 2$ ;ERROR!! BIS #DV.ASGN,@R4 ;MARK NAME AVAILABLE RETURN 2$: ERROR BABRANCH IF NOT TSTB @R0 ;IS IT ALREADY OPEN? BMI 13$ ;BRANCH IF SO JSR PC,$OPEN ;DO THE OPEN ; 13$: ;TIME TO RETURN .IF DF F4 MOV (SP)+,R4 ;RESTORE THREADED CONTINUATION RTS PC .ENDC ;DF F4 .IF DF F4P 14$: MOV #FIRSTD,R4 ;SET FAKE THREADED CONTINUATION RTS PC ; ;FORTRAN IV COMPATIBLE TECHNIQUE TO HANDLE CO-ROUTINE RETURN FOR ;FIRST I/O LIST ELEMENT ; OTS$D FIRSTD: +FIRSTI ;D-SPACE POINTER BACK TO I-SPACE OTS$I FIRSTI: MOV (SP)+,W.EXJ(R3) ;SAVE CO-ROUTINE ADDIND UP AS -5 TO PRINT 4 BLANKS NOTG: SUB R2,@SP ;DECREASE SCALE FACTOR BY P FACTOR ASRB OFLAGS(SP) BCS 1$ ;IF FORMAT IS E OR D THEN ASL R2 ;NUMBER OF DIGITS BEFORE DECIMAL POINT IS ADD @SP,R2 ;DETERMINED SOLELY BY P FACTOR, ELSE BY 1$: MOV R2,R3 ;THE SUM OF SCALE FACTOR AND P FACTOR. BGT 2$ ;JUMP IF DIGITS LEFT OF D.P. MOV #1,R3 ;NONE - FORCE 1 2$: SUB OSIGN(SP),R3 ;ADD IN SPACE FOR SIGN, IF NEGATIVE MOV R2,-(SP) ;SAVE NUMBER OF DIGITS LEFT OF D.P. MOV OFIELD+2(SP),R2 ;GET FIELDLETTER ROUTINE FCDE P, PFMT FCDE Q, QFMT FCDE T, TFMT FCDE X, XFMT FCDE H, HFMT FCDE A, RP1 FCDE L, RP1 FCDE O, RP1 FCDE I, RP1 FCDE F, RP2 FCDE E, RP2 FCDE G, RP2 FCDE D, RP2 ; POSITION PROGRAM COUNTER AT END OF TABLE FCDE Z, ERR OTS$I ;PURE CODE SECTION FOLLOWS ; T FORMAT TFMT: TST NOARG(R3) ;ARGS TO BE COLLECTED FROM BEFORE? ERRHLP: BNE ERR ;ERROR IF SO TST NUMFLG(R3) ;PRECEDING REPEAT COUNT? BNE ERR ;ERROR IF SO MOV #1,NOARG(R3) ;A FOLLOWING COUNT REQUIREDSPC ;BAD FILE NAME SPECIFICATION INC W.OPFL(R3) ;IT IS FATAL RETURN .SBTTL TYPE ; TYPE ; ; FUNCTION ; PROCESS THE FILE TYPE SPECIFICATION ; ; INPUTS ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; OLD=1 NEW=2 SCRATCH=3 UNKNOWN=4 TYPECD: BIC #DV.NEW,D.STA2(R4) ;CLEAR DEFAULT TYPE CMP 2(R5),#OLD ;IS IT AN OLD FILE? BNE 1$ ;NO BIS #DV.OLD,D.STA2(R4) ;MARK AS OLD BR 3$ 1$: CMP 2(R5),#NEW ;IS IT NEW? BNE 2$ ;NO BIR RTS PC ;EXIT ; ;END OF I/O LIST PROCESSING ; EOLST$:: JSR PC,$SAVP0 $AOTS MOV SP,FMTCLN(R3) ;STACK ADDRESS FOR END=/ERR= TRANSFERS CLR VARAD(R3) ;CLEAR VARIABLE ADDRESS TO SIGNAL NO MORE LIST ITEMS JSR PC,@W.EXJ(R3) ;RETURN TO RECORD ROUTINE TO FINISH UP $AOTS CLR ENDEX(R3) CLR ERREX(R3) CLR FILPTR(R3) ;SET NO I/O OPERATION IN PROGRESS RTS PC .ENDC ;DF F4P .END POINTER ADD OD+2(SP),R3 ;ADD DIGITS RIGHT OF D.P. TO TOTAL SUB OLEN+2(SP),R3 ;SPACE NEEDED, AND COMPARE WITH FIELD WIDTH BGT ASTRSK ;IF FIELD WIDTH EXCEEDED, ERROR JSR PC,OBLNKS ;PRINT CORRECT NUMBER OF LEADING BLANKS TST OSIGN+2(SP) ;CHECK SIGN OF NUMBER BPL 3$ MOVB #'-,(R2)+ ;NEGATIVE - OUTPUT MINUS SIGN 3$: TST @SP ;ANY DIGITS BEFORE D.P.? BLE PRZERO ;NO - PRINT 0. AND LEADING ZEROES DIGLP: JSR PC,MUL5 ;PRINT DIGITS BY MULTIPLYING FAC JSR PC,LEFT ;BY 10 AND PRINTING OVERFLOW OD BR OBJBYT ;OUTPUT FORMAT CODE AND CONTINUE ; X FORMAT XFMT: BR FREPT ; A, I, L, O FORMATS RP1: JSR PC,DFLTWD ;HANDLE DEFAULT W RP1A: JSR PC,FREPT MOV #1,NOARG(R3) ;NUMBER OF ARGS RTS PC ; F, E, G, D FORMATS RP2: JSR PC,DFLTWD ;HANDLE DEFAULT W.D JSR PC,FREPT MOV #2,NOARG(R3) RTS PC ; DEFAULT W(.D) HANDLING ; IF NUMERIC FOLLOWS THEN TREAT AS NORMAL CASE (JUST RETURN) ; ELSE ASSUME DEFAULT, AND TRANSFORM FORMAT CODE. ; DFLTWD: CMPB #' ,(R5)+ ;SKIP BLANKS BEQ DFLTWD S #DV.NEW,D.STA2(R4) ;MARK IT AS NEW BR 3$ 2$: CMP 2(R5),#SCRATCH ;IS THIS A SCRATCH FILE? BNE 4$ ;NO, IT IS UNKNOWN BIS #DV.SCR,D.STA2(R4) ;MARK SCRATCH FILE BIS #DV.DEL,D.STA2(R4) ;AND MARK FOR DELETION 3$: RETURN 4$: BIS #DV.UNK,D.STA2(R4) ;MARK IT AS UNKNOWN RETURN .SBTTL ACCESS ; ACCESS ; ; FUNCTION ; SELECT RANDOM ACCESS OR SEQUENTIAL ACCESS. ; ; INPUTS ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; RANDOM=1 SEQUEN=2 .TITLE $ASSIGN -CALL ASSIGN SUBROUTINE IDENT 08 ;RFB 30-SEP-74 ; ; COPYRIGHT (C) 1974, ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UUT MOV R0,R3 ;OF BIT 59. BIC #7777,R3 ;THIS RESULT IS IN AN UNFORTUNATE BIC R3,R0 ;PLACE FOR THE PDP-11'S LIMITED SWAB R3 ;SHIFT INSTRUCTIONS ASR R3 ASR R3 ASR R3 ASR R3 ADD #'0,R3 ; AT LAST - MAKE ASCII DIGIT MOVB R3,(R2)+ ;AND STORE IT DEC @SP ;COUNT DIGITS BEFORE D.P. BGT DIGLP ;STILL IN FRONT OF IT BEQ PRDECP ;AT IT - PRINT PERIOD AND CONTINUE DIGLP1: DEC OD+2(SP) ;AFTER DECIMAL POINT - COUNT DOWN D SPEC BPL DIGLP ;UNTIL EXHAUSTED DIGOVR: TST (SP)+ ;POP PRE-D.P. CMPB #'0,-(R5) ;NUMERIC? BHI 2$ ;BRANCH IF NOT CMPB #'9,@R5 ;NUMERIC? BLO 2$ ;BRANCH IF IT IS 1$: RTS PC ;RETURN FOR NORMAL PROCESSING 2$: ADD #DCODE-ACODE+2,R0 ;TRANSFORM CODE TST (SP)+ ;DISCARD A RETURN BR FREPT ; H FORMAT HFMT: JSR PC,FREPT1 ;CODEH AND COUNT 1$: MOVB (R5)+,R0 ;GET CHAR JSR PC,OBJBYT ;PUT INTO FORMAT DEC R2 BPL 1$ ;LOOP TIL COUNT OVER RTS PC ; P FORMAT PFMT: TST NOARG(R3) ;SOMEBODY REQUESTING ARGS? BNE ERR ;ERROR IF SO BIT #^C<127.>,R4 ;NUMBER IN APPEND=3 ACCESS: CMP 2(R5),#RANDOM ;IS IT RANDOM ACCESS? BNE 2$ ;NO BIS #DV.DFD,(R4) ;SET RANDOM RETURN 2$: CMP 2(R5),#APPEND ;IS IT APPEND? BNE 3$ ;NO, MUST BE SEQUENTIAL BIS #DV.APD,D.STA2(R4) ;MARK FOR APPEND 3$: RETURN .SBTTL FORM ; FORM ; ; FUNCTION ; SELECT FORMATTED OR UNFORMATTED I/O ; ; INPUTS ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; FMTTED=1 UNFMTD=2 FORMAT: CMP 2(R5),#FMTTED ;IS IT FORMATTED? BNE NDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H. JACOBS, D. KNIGHT, R. BRENDER 16-AU-74 OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION ASSIGN:: MOV (R5)+,R4 ;GET THDIGIT COUNT MOV (SP)+,R5 ;R0-1,R4-5 NOW FREE - GET SCALE FACTOR TST (SP)+ ;POP SIGN WORD MOV (SP)+,R3 ;GET FLAGS INTO R3 ASRB R3 ;SEE IF G, E OR D FORMAT BCC ODONE ;NO - WE'RE FINISHED ASRB R3 ;THIS BIT ONLY SET IF G PRINTING AS F BCC PRTEXP ;IF NOT SET, PRINT EXPONENT JSR PC,OBLNKS ;OTHERWISE PRINT 4 BLANKS (R3=-5) ODONE: MOV (SP)+,R0 ;POP RETURN PC MOV (SP)+,R4 ;RESTORE R4 AND R5 MOV (SP)+,R5 ADD #OFIELD-OP+2,SP ;BUMP STACK PAST ARGS ROL R3 ;GET ERROR FLAG IN CARRY JMP @ RANGE? BNE ERRHLP ;ERROR - P SCALE OUT OF BOUNDS TST NUMFLG(R3) ;MINUS SIGN SEEN? BPL 1$ ;NO, GO STORE CODE AND VALUE NEG R2 ;NEGATE VALUE FIRST 1$: BR FREPT3 ; Q FORMAT QFMT: JSR PC,ENDLST MOV #QCODE,R0 BR OBJBYT .END 1$ ;NO BIS #DV.FMP,(R4) ;SET FORMATTED RETURN 1$: BIS #DV.UFP,(R4) ;SET UNFORMATTED RETURN .SBTTL RECORDSIZE ; RECSIZ ; ; FUNCTION ; SET UP RECORD SIZE FOR FILE ; ; INPUTS ; R3 - WORK AREA POINTER ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; RECSIZ: CALL GETVAL ;GET PARAMETER VALUE INTO R0 AND R1 BNE 1$ ;THE VALUE IS TOO LARGE CMP R0,W.BLEN(R3) ;IS IT LARGER THAN THE BUFFER SIZE? BLOS 2$ ;NO, ALL IS OK 1$: ERROR BDOPRE NUMBER OF ARGS MOV @(R5)+,R2 ;GET THE LUN NUMBER $AOTS ;WORKAREA POINTER TO R3 MOVB #1,W.IOEF(R3) ;FLAG SPECIAL ERROR HANDLING JSR PC,$GETFILE ;SET THE ADDRESS OF FILPTR BPL 1$ ;BRANCH IF FILE UNOPENED ERROR FILOPN ;VERY BAD TO CHANGE FDB WITH OPEN FILE BR EXITR ;JUST EXIT 1$: BIC #DV.ASGN,@R0 ;ASSUME DEFAULT NAME JSR PC,GETARG ;GET THE ADDRESS OF THE NEXT ARG BEQ EXITR ;EXIT LEAVING DEFAULT SETTING IF NULL 2$: MOV R2,R1 ;SAVE ADDRESS OF FILE SPEC CLR -(SP) ;SET INIT LENGTHR0 OBOUT: MOVB #' ,(R2)+ ;OUTPUT A BLANK OBLNKS: INCB R3 ;TEST IF ANY MORE BLANKS TO OUTPUT BMI OBOUT ;YES NORMXT: RTS PC ;NO TOOLOW: JSR PC,LEFT ;SHIFT FAC LEFT ONE DEC R2 ;AND DECREMENT BINARY EXPNENT NORM: CMP #4000,R0 ;NORMALIZE FAC TO BIT 59 - I.E. BHI TOOLOW ;HIGH ORDER WORD SHOULD BE BETWEEN 1$: CMP #10000,R0 ;4000 AND 7777. BHI NORMXT JSR PC,RIGHTC ;TOO HIGH - SHIFT FAC RIGHT ONE INC R2 ;AND INCREMENT BINARY EXPONENT BR 1$ PRZERO: DEC R3 ;TEST FOR SPACE FOR LEAD ZERO .TITLE $IRF -INPUT RANDOM FORMATTED IDENT 05 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; ;+ ; FUNCTION: ; ; INITIATE RANDOM FORMATTED READ ; ; CALLING SEQUENCE: ; ; PUSH ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,IFR(E)$ ; ; RETURNS WITH ARGUMENTS DELETED AND CONTEXT ; PESERVED, READY FOR 1/0 ELEMENT TRANSMISSION. ; ;- OTSWA FBLOCK OTS$IC ;YES INC W.OPFL(R3) ;MARK IT AS A FAILURE 2$: MOV R0,F.RSIZ+D.FDB(R4) ;SET UP THE RECORD SIZE RETURN .SBTTL CARRIAGECONTROL ; CARRIAGECONTROL ; ; FUNCTION ; SET CARRIAGE CONTROL ATTRIBUTES ; ; INPUTS ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; FTRNC=1 LISTC=2 NOCC=3 CARCON: BICB #FD.CR!FD.FTN,F.RATT+D.FDB(R4) ;CLEAR OLD CARRIAGE CONTROL BIS #DV.CC,D.STA2(R4) ;SET EXPLICIT CARRIAGE CONTROL CMP 2(R5),#FTRNC ;IS IT FTN OF FILE SPEC DECB R4 ;IS THERE A LENGTH ARG? BEQ 3$ ;BRANCH IF NOT TO SCAN JSR PC,GETCNT ;GO GET ITS ADDRESS BEQ 3$ ;BRANCH IF NULL MOV @R2,@SP ;SET GIVEN COUNT AND GO PROCESS BNE 4$ ;USE NON-ZERO LENGTH 3$: MOV R1,R2 ;MAKE COPY OF FILE SPEC ADDRESS 6$: INC @SP ;BUMP CHAR COUNT TSTB (R2)+ ;SEE IF CHAR NULL BNE 6$ ;WE'VE GOT COUNT +1 5$: DEC @SP ;REMOVE +1 FROM CHAR COUNT 4$: MOV (SP)+,R2 ;PUT FILE SPEC LENGTH IN R2 BLE 8$ ;BRANCH IF LENGTH ERROR JSR PC,$FNBST ;SET UP TH BEQ PRDECP ;NO SPACE MOVB #'0,(R2)+ ;OUTPUTLEAD ZERO PRDECP: MOVB #'.,(R2)+ ;OUTPUT DECIMAL POINT 1$: TST @SP ;ANY LEADING ZEROS AFTER DECIMAL POINT? BEQ DIGLP1 ;NO - START ON SIGNIFICANT DIGITS MOVB #'0,(R2)+ ;OUTPUT A LEADING ZERO INC @SP ;BUMP COUNT DEC OD+2(SP) ;THESE COUNT TOWARDS D SPECIFICATION BNE 1$ BR DIGOVR ;NUMBER WAS ALL ZEROES. PRTEXP: SWAB R3 ;HIGH BYTE OF R3 HAS "E" OR "D" MOVB R3,(R2)+ ;OUTPUT IT MOV #" -,R3 TST R5 ;GET SIGN OF EXPONENT (IN R5) BPL 2$ IRF$:: JSR PC,$SAVP4 MOV #FL.REC!FL.FMT!FL.RD,R1 BR IRF IRFE$:: JSR PC,$SAVP6 MOV #FL.RD!FL.REC!FL.FMT!FL.ERR,R1 IRF: JSR PC,$INITIO MOV #GETR,RECIO(R3) JMP $FIO GETR: JSR PC,$GETR ;GET RECORD MOV F.NRBD+2(R0),R1 ;RECORD ADDRESS MOV R1,LNBUF(R3) ;FOR FIO MOV R1,BLBUF(R3) ADD F.NRBD(R0),R1 ;COMPUT END OF RECORD MOV R1,EOLBUF(R3) RTS PC .END FORMAT? BNE 1$ ;NO BISB #FD.FTN,F.RATT+D.FDB(R4) ;YES, SET FORTRAN CONTROL RETURN 1$: CMP 2(R5),#LISTC ;IS IT LIST CONTROL? BNE 2$ ;NO, MUST BE NONE BISB #FD.CR,F.RATT+D.FDB(R4) ;SET 2$: RETURN .SBTTL READONLY ; RDONLY ; ; FUNCTION ; SET UNIT TO READ ONLY ; ; INPUTS ; R4 - LUN BLOCK POINTER ; ; OUTPUTS ; VALUE - NONE. ; RDONLY: BIS #DV.RDO,D.STA2(R4) ;SET READ ONLY RETURN .SBTTL BUFFERCOUNT ; BUFCNT ; ; FUNCTION ; SET UP COUNT OF BUFFERS TO BE UE FNB BCC 7$ ;JUMP IF GOOD 8$: ERROR BADSPC ;BAD FILE SPECIFICATION BR EXITR 7$: BIS #DV.ASGN,@FILPTR(R3) ;SET EXPLICIT FILE NAME BIT EXITR: CLR FILPTR(R3) ;RELEASE I/O SYSTEM CLRB W.IOEF(R3) ;CLEAR SPECIAL ERROR HANDLING RTS PC GETARG: DECB R4 ;DECRMENT ARG CPUNT BLE DONE ;DONE WHEN WE HIT 0 (OR LESS??) GETCNT: MOV (R5)+,R2 ;GET ADDRESS OF NEXT ARG CMP #-1,R2 ;SET CONDITION CODE FOR NULL ARGS RTS PC ;RETURN DONE: TST (SP)+ ;REMOVE SUBR RETURN ADDRESS BR EXITR ;FREE I/O S NEG R5 SWAB R3 2$: MOVB R3,(R2)+ ;OUTPUT BLANK OR MINUS MOVB #'0-1,@R2 ;DIVIDE EXPONENT BY 10 THE LONG WAY 3$: INCB @R2 ;TO GET THE TWO DIGITS SUB #10.,R5 ;WITH LEADING ZEROES BPL 3$ ADD #'0+10.,R5 MOVB R5,1(R2) BR ODONE ASTRSK: COM R3 ;SET LOW-ORDER BIT OF R3 (ERROR FLAG) ADD #OFLAGS+2,SP ;MOVE STACK POINTER UP TST (SP)+ ;CHECK IF F FORMAT BEQ 1$ ;IF FLAGS ARE ZERO, YES ADD #4,OLEN-OFLAGS-2(SP) ;OTHERWISE LENGTH IS 4 TOO SMALL 1$: MOVB #'*,(R2)+ ;FILL FIELD WITH ASTERISK .TITLE $IOARY - I/O TRANSMISSION FOR ARRAYS IDENT 03 ;RFB 24-SEP-74 ; ; ;THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ;EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO ;RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. ; ;THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER ;UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE ;COPIED (WITH INCLUSION OF DIGITSED ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; BUFCNT: CALL GETVAL ;GET NUMBER OF BUFFERS BEQ 1$ ;VALUE IS NOT LARGE ERROR NBUFRM ;NO ROOM FOR THAT MANY BUFFERS INC W.OPFL(R3) ;MARK BAD BUFFER COUNT 1$: MOVB R0,D.FDB+F.MBCT(R4) ;SET THE BUFFER COUNT RETURN .SBTTL INITIALSIZE ; INITSZ ; ; FUNCTION ; SET UP INITIAL FILE ALLOCATION SIZE ; ; INPUTS ; R3 - WORK AREA POINTER ; R4 - LYSTEM AND EXIT .END S DEC OLEN-OFLAGS-2(SP) BNE 1$ BR ODONE .END AL'S COPYRIGHT NOTICE) ;ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED ;IN WRITING BY DIGITAL. ; ;DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE ;OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED ;BY DIGITAL. ; ;COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION ; ;R. BRENDER 15-JUN-74 ; ;+ ;FUNCTION: ; HANDLE I/O TRANSMISSION FOR ARRAY ; LIST ELEMENTS ; ;CALLING SEQUENCE: ; ; PUSH

; JSR PC,IOAAUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; INITSZ: CALL GETVAL ;GET THE INITIALSIZE BEQ 1$ ;VALUE IS NOT TOO LARGE ERROR BDOPFS ;YES INC W.OPFL(R3) ;MARK ERROR 1$: MOV R0,F.CNTG+D.FDB(R4) ;SAVE THE ALLOCATION SIZE RETURN .SBTTL EXTENDSIZE ; EXTEND ; ; FUNCTION ; SET UP THE SIZE FOR FILE EXTENSION. A POSITIVE ; VALUE FOR A CONTIGUOUS EXTEND, A NEGATIVE VALUE ; FOR A NON-CONTIGUOUS EXTEND. ; ; INPUTS ; R3 - WORK AREA POINTER ; R .TITLE $IRU -INPUT RANDOM UNFORMATTED IDENT 06 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; R.SCHAEFER 16 JUL 74, 17 JUL 74 ; ;+ ; FUNCTION: ; INITIATE AND COMPLETELY HANDLE ; RANDOM UNFORMATTED READ STATEMENT. ; ; CALLING SEQUENCE: ; ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,IRU(E)$ ; ;- OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION IRU$:: JSR PC,$SAVP3 MO .TITLE $FNBST -FILE NAME BLOCK SETTER IDENT 07 ;RFB 30-SEP-74 ; ; COPYRIGHT 1974, ; DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY IF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL EQUIPMENT CORPORATION. ; ; D. KNIGHT 07/24/74 ; ; UTILITIES FOR OPEN$ AND $OPEN ; ; MACRO PROTOTYPES .MACRO RETURN RTS PC .ENDM ; DATA AREAS AND FIELD DEFINTIONS OTSWA FBLOCK ERRDEF .MCA$ ;- OTSWA ADBDEF ERRDEF OTS$I ;PURE CODE SECTION IOAA$:: JSR PC,$SAVP1 $AOTS MOV SP,FMTCLN(R3) ;SAVE STACK FOR ERR= TRANSFERS MOV @R0,R0 ;ADB ADDR TO R0 MOV A.CWRD(R0),R1 ;EXTRACT # DIMENSIONS SWAB R1 BIC #177770,R1 ;UP TO 7 ALLOWED ; ;COMPUTE NUMBER OF ELEMENTS ; MOV R0,R2 ;ADR OF D1 TO R2 ADD #A.D1,R2 MOV #1,R5 ;INIT RESULT 1$: MUL (R2)+,R5 ;TAKE PRODUCTS SOB R1,1$ ;LOOP ON ALL DIMENSIONS ; ;DETERMINE DATA TYPE ; MOV A.CWRD(R0),R1 ASH #-11.,R1 BIC #174 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; EXTEND: CALL GETVAL ;GET THE EXTEND SIZE BEQ 1$ ;SKIP IF SMALL NUMBER ERROR BDOPES ;YES INC W.OPFL(R3) ;MARK ERROR 1$: MOV R0,F.ALOC+D.FDB(R4) ;SAVE THE EXTEND SIZE RETURN .SBTTL NOSPANBLOCKS ; NOSPAN ; ; FUNCTION ; DISALLOW RECORDS FROM CROSSING BLOCK BOUNDARIES IN THE ; BUFFER. ; ; INPUTS ; R4 - LUN BLOCK POINTER ; ; OUTPUTS ; VALUE - NONE. ; NOSPAN: BISB #FD.BLK,F.RATT+DV #FL.REC!FL.RD,R1 BR IRU IRUE$:: JSR PC,$SAVP5 MOV #FL.ERR!FL.REC!FL.RD,R1 IRU: JSR PC,$INITIO JSR PC,$GETR MOV F.NRBD+2(R0),BLBUF(R3) ;RECORD ADDRESS MOV F.NRBD(R0),RACNT(R3) ;AND LENGTH JSR PC,@(R4)+ ;GET FIRST VARIABLE 3$: $AOTS MOVB ITEMSZ+1(R3),R2 MOV VARAD(R3),R1 BNE 1$ RTS PC 1$: DEC RACNT(R3) BMI 2$ MOVB @BLBUF(R3),(R1)+ INC BLBUF(R3) SOB R2,1$ JSR PC,@(SP)+ ;GET ANOTHER VARIABLE BR 3$ 2$: ERROR RECSML ;RECORD TOO SMALL .END LL CSI$,CSI$1,CSI$2 ; $FNBST ; ; SET UP THE FNB FOR THE STRING PASSED. ; ; INPUTS ; R1 - STRING ADDRESS OF DATA ; R2 - LENGTH OF STRING ; R3 - WORK AREA POINTER ; ; OUTPUTS ; VALUE - NONE. ; FNB IS SET UP ; $FNBST::MOV R3,-(SP) ;R3 IS SAFE MOV R4,-(SP) ;SO IS R4 AND MOV R5,-(SP) ;R5 MOV R2,R4 ;GET STRING LENGTH INC R4 ;ROUND IT BIC #1,R4 ;TO THE NEAREST WORD SUB R4,SP ;NOW RESERVE SOME SPACE ON THE STACK ;FOR THE TEXT MOV SP,R5 ;GET ADDRESS OF TEMP STORAGE 7760,R1 ;TYPE CODE IN R1 ; ;PICK UP BYTES PER ELEMENT, ;MAKE COMPLEX LOOK LIKE 2 REALS, ;SET UP WORK AREA, AND ;DO ELEMENT PASSING. ; MOV R1,W.VTYP(R3) MOVB A.BPE(R0),R2 ;BYTES PER ELEMENT CMP #A.CMP8,R1 ;COMPLEX? BNE 2$ ;BRANCH IF NOT ASL R5 ;DOUBLE COUNT ASR R2 ;HALVE BPE MOV #A.REA4,W.VTYP(R3) 2$: MOV R2,ITEMSZ(R3) MOVB R2,ITEMSZ+1(R3) MOV A.ASTR(R0),VARAD(R3);INITIAL ADDR MOV R5,COUNT(R3) ;ITEM COUNT MOV W.EXJ(R3),-(SP) ;PICK UP CO-ROUTINE LINK 3$: JSR PC,@(SP)+ ;PASS .FDB(R4) ; DISALLOW CROSSING BLOCK BOUNDARIES RETURN .SBTTL SHARED ; SHARED ; ; FUNCTION ; MARK FILE AS SHARED IN FDB ; ; INPUTS ; R4 - LUN BLOCK POINTER. ; ; OUTPUTS ; VALUE - NONE. ; SHARED: BISB #FA.SHR,F.FACC+D.FDB(R4) ;SET THE SHARED BIT RETURN .SBTTL DISPOSE ; DISPOS ; ; FUNCTION ; MARK FILE FOR PRESERVATION OR DELETION ; ; INPUTS ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; SAVE=1 DELETE=2 SPOO .TITLE $OTI OTS INITIALIZATION MODULE IDENT 14 ;RFB 25-SEP-74 ; ;DISCLAIMER ; ; R. BRENDER 27-MAY-74 ; ; MODIFIED BY: ; B.LEAVITT 29-MAY-74 ; R. BRENDER 31-MAY-74 ; ;+ ; FUNCTION: ; INITIALIZE THE OBJECT TIME SYSTEM IMPURE ; WORK AREA. INITIALIZATION MUST BE COMPLETE IN ; THE SENSE THAT TASKS FIXED IN MEMORY MUST ; BE SERIALLY REUSABLE. ; ; CALLING SEQUENCE: ; 1) FOR FORTRAN IV ; JSR R4,$OTI ; ; 2) FOR FORTRAN IV-PLUS ; JSR PC,OTI$ ; ;- OTSWA MOV R2,R0 ;COUNT OF ITEMS TO MOVE 1$: MOVB (R1)+,(R5)+ ;MOVE THE STRING SOB R0,1$ ;ONE BYTE AT A TIME MOV SP,R1 ;NEW STRING ADDRESS MOV #C.SIZE/2,R5 ;CSI CONTROL BLOCK 3$: CLR -(SP) ; IS ALLOCATED ZEROED SOB R5,3$ CSI$1 SP,R1,R2 ;INIT CONTROL BLOCK BCS 2$ ;EXIT IN ERROR CSI$2 SP,OUTPUT ;SET UP THE NEEDED DSPT BCS 2$ ;BRANCH IF ALL NOT WELL BITB #CS.WLD!CS.MOR,C.STAT(SP) ;IS IT LEGAL? BNE 2$ ;NO MOV FILPTR(R3),R0 ;RESTORE FDB ADDRESS ADD #D.FDB,R0 ;POINT TO FDB PROPER MOVELEMENT $AOTS ;TO BE SAFE MOVB ITEMSZ(R3),R2 ADD R2,VARAD(R3) ;ADDR OF NEXT ELEMENT DEC COUNT(R3) BNE 3$ ;BRANCH IF MORE ELEMENTS MOV (SP)+,W.EXJ(R3) ;SAVE CO-LINK RTS PC .END L=3 DISPOS: CMP 2(R5),#DELETE ;MARK FILE FOR DELETION? BLE 3$ ;MUST BE SAVE BNE 1$ ;NO BIS #DV.DEL,D.STA2(R4) ;MARK FILE FOR DELETION RETURN 1$: CMP 2(R5),#SPOOL ;DO WE SPOOL IT? BNE 2$ ;NO BIS #DV.SPL,D.STA2(R4) ;MARK FILE FOR SPOOLING 2$: RETURN 3$: BIS #DV.SAV,D.STA2(R4) ;MARK FOR SAVE RETURN .SBTTL ERR ; ERROR ; ; FUNCTION ; SET ERR= TRANSFER FOR OPEN ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; FBLOCK ERRDEF OTS$I ;PURE CODE SECTION .IF DF F4P OTI$:: .IFF $OTI:: .ENDC $AOTS ;WORK AREA POINTER TO R3 MOV #15.,W.ECNT(R3) ;SETUP MAX ERROR COUNT ;+ ; INITIALIZE THE SYNCHRONOUS TRAP TABLE ADDRESS ;- .MCALL SVTK$S SVTK$S W.SST(R3),#8. BCS INITNG ;+ ; ZERO ALL DEVICE TABLE ENTRIES ;- MOV W.DEV(R3),R0 ;ADDR OF TABLES MOV W.LUNS(R3),R1 ;NUMBER OF TABLES BEQ 3$ ;SKIP IF NO LUNS 2$: MOV #,R2 ;DEV LENGTH IN WORDS 1$: CLR (R0)+ SOB R2,1$ ;LOOP R0,R1 ;POINT TO ADD #F.FNB,R1 ; FNB MOV SP,R2 ;SET ADDRESS OF DSPT ADD #C.DSDS,R2 ;DATA SET DECSRIPTOR ADDRESS CLR R3 ;NO DEFAULT FNB JSR PC,.PARSE ;PARSE THE FILE NAME AND ASSIGN LUN $AOTS ;RESTORE OTS WORK AREA POINTER TO R3 ; (LEAVES C-BIT FROM .PARSE) BCS 2$ ;BRANCH IF .PARSE DIDN'T WORK BITB #CS.NMF,C.STAT(SP) ;WAS THERE A NAME? BNE 4$ ;BRANCH IF SO JSR PC,$FLDEF ;OTHEREWISE FILL IN THE DEFAULT NAME 4$: ADD #C.SIZE,SP ;REMOVE CSI BLOCK FROM STACK ADD R4,SP ;REM .TITLE $ORF -OUTPUT RANDOM FORMATTED IDENT 04 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; ;+ ; FUNCTION: ; INITIATE RANDOM FORMATTED WRITE ; ; CALLING SEQUENCE: ; ; PUSH ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,ORF(E)$ ; ; RETURNS WITH ARGUMENTS DELETED, CONTEXT ; PRESERVED AND EXPECTING I/O ELEMENT ; TRANSMISSION TO FOLLOW. ; ;- OTSWA FBLOCK OTS$IERR: MOV 2(R5),ERREX(R3) ;SET UP "ERR=" EXIT RETURN .SBTTL MAXREC ; MAXREC ; ; FUNCTION ; SET MAXIMUM RECORD SIZE FOR RANDOM I/O ; ; INPUTS ; R3 - ADDRESS OF WORK AREA ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; VALUE - NONE. ; MAXREC: CALL GETVAL ;GET INTEGER VALUE CMPB 1(R5),#3 ;I*4? BEQ 1$ ;YES TST R0 ;NEGATIVE? BMI 3$ ;YES, ERROR BR 2$ 1$: TST R1 ;I*4 NEGATIVE? BMI 3$ ;YES, ERROR 2$: MOV R0,D.RCNM(R4) ;PUT AWAY THE MOV R1,DIF MORE THIS ENTRY SOB R1,2$ ;LOOP IF MORE ENTRIES 3$: ;AREA CLEARED ;+ ; COPY ERROR CONTROL TABLE INITIAL STATE INTO ; IMPURE AREA ;- MOV W.ERTB(R3),R0 ;WHERE TO PUT IT MOV #$ERRTB,R1 ;BEGIN OF TABLE MOV #$ERRTE,R2 ;LENGTH OF TABLE SUB R1,R2 ;IN WORDS ASR R2 ;TO R2 4$: MOV (R1)+,(R0)+ ;COPY SOB R2,4$ ;LOOP IF MORE ;+ ; COMPUTE USER I/O BUFFER LENGTH ; AS DETERMINED BY TKB MAXBUF COMMAND ;- MOV W.BEND(R3),R0 SUB W.BFAD(R3),R0 MOV R0,W.BLEN(R3) ;+ ; CLEAR MIOVE TEXT SCRATCH FROM STACK CLC ;SUCCESS FLAG BR 5$ ;TO EXIT 2$: ADD #C.SIZE,SP ADD R4,SP SEC ;ERROR FLAG 5$: MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 ;RESTORE R3 RETURN .END ;PURE CODE SECTION ORF$:: JSR PC,$SAVP4 MOV #FL.REC!FL.FMT!FL.WRT,R1 BR ORF ORFE$:: JSR PC,$SAVP6 MOV #FL.REC!FL.FMT!FL.ERR!FL.WRT,R1 ORF: JSR PC,$INITIO MOV #$PUTR,RECIO(R3) MOV #100000+' ,R2 ;PAD RECORD WITH BLANKS JSR PC,$PUTRI MOV F.NRBD+2(R0),R1 ;RECORD ADDRESS MOV R1,BLBUF(R3) MOV R1,LNBUF(R3) ADD F.NRBD(R0),R1 ;COMPUTE END OF RECORD MOV R1,EOLBUF(R3) JMP $FIO .END .RCN2(R4) ;RECORD COUNT RETURN 3$: ERROR BADRCN ;BAD RECORD NUMBER INC W.OPFL(R3) ;MARK ERROR RETURN .SBTTL ASSOCIATED VARIABLE ;ASSOCIATE VARIABLE INITIALIZATION ; ; FUNCTION ; SET ASSOCIATE VARIABLE ADDRESS IN ; FORTRAN DEVICE CONTROL BLOCK ; ; INPUT ; R3 - ADDRESS OF WORK AREA ; R4 - LUN BLOCK POINTER ; R5 - ADDRESS OF ARGUMENT BLOCK ; ; OUTPUTS ; NONE ; ASSOCV: MOV 2(R5),D.AVAD(R4) ;COPY ADDRESS CMPB #3,1(R5) ;IS IT I*4? BNE 1$ ;BRANCH IF NOT BIS #DV.AI4,D.SSC WORDS THAT MUST BE INITIALLY ZERO ; BASED ON A TABLE OF OFFSETS THAT FOLLOW. ; (TABLE IS TERMINATED BY A ZERO OFFSET.) ;- MOV #OFLST,R0 6$: MOVB (R0)+,R1 ;GET OFFSET TO R1 BEQ OTI1 ;QUIT ON ZERO BIC #177400,R1 ;CLEAR ANY SIGN EXTEND ADD R3,R1 ;MAKE INTO ADDR CLR @R1 ;CLEAR THE WORD BR 6$ ;LOOK FOR MORE ; ; THE TABLE OF OFFSETS ; OTS$D ;PURE DATA SECTION OFLST: .BYTE W.NAMC,FILPTR,ENDEX,ERREX,W.ERNM,W.ERUN .BYTE W.FERR,W.FER1,W.PC,EXADDR,W.MOTY,W.PNTY,0 .EVEN .TITLE $CLOSE -FILE CLOSE ROUTINE IDENT 07 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UNDER A .TITLE $CKRCN - CHECK RANDOM ACCESS RECORD NUMBER IDENT 04 ;RFB 26-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; ;+ ; FUNCTION: ; 1) $CKRCN- CHECK THAT RANDOM ACCESS RECORD NUMBER IS ; WITHIN LIMITS DECLARED IN DEFINE FILE. ; ISSUE ERROR IF NOT. ; ; 2) $ASVAR - ASSOCIATED VARIABLE UPDATE. ; ;- OTSWA ERRDEF FBLOCK ;+ ; CALLING SEQUENCE - $CKRCN ; ; R0 = DEVICE TABLE ADDRESS ; R3 = WORK AREA ADDRESS ; JSR PC,$CKRCN ; R0,R3,R4,R5 UNCHANGED ; R1,R2 = RECORD NUMBER ;TA2(R4) ;MARK I*4 TYPE 1$: RTS PC .SBTTL DO THE ACTUAL OPEN ; OPEN ; ; FUNCTION ; NOW THAT ALL OF THE PARAMETERS HAVE BEEN PROCESSED, ; EXECUTE THE ACTUAL OPEN AND CHECK FOR ANY ERRORS. ; ; INPUTS ; R3 - WORK AREA POINTER ; R4 - LUN BLOCK POINTER ; ; OUTPUTS ; VALUE - NONE. ; ; NOTE: R5 IS NO LONGER REQUIRED AS A PARAMETER POINTER ; AND IS HEREIN DESTROYED. ; OPEN: MOV W.OPFL(R3),R5 ;GET ERROR COUNT BIT #DV.FMP!DV.UFP,(R4) ;IS FORM DETERMINED? BNE 17$ ;BRANCH IF YES OTS$I ;PURE CODE SECTION OTI1: .IF DF FPP&F4P ;+ ; FOR F4P EXPECTING FPP, SEE IF THE FPP HARDWARE ; IS ACTUALLY PRESENT. IF NOT SET A FLAG FOR THE REST ; OF THE OTS AND KEEP GOING. IT MAY BE THAT THIS PROGRAM ; DOES NOT NEED FPP AND CAN EXECUTE ANYWAY. ;- MOV W.SST(R3),R2 ;ADDR OF SST VECTOR ADD #8.,R2 ;ADDR OF ILLEGAL INSTR TRAP LOC MOV @R2,R1 ;SAVE REAL HANDLER ADDR MOV #1$,@R2 ;INSERT TEMPORARY ADDR CFCC ;LEGAL INSTRUCTION? MOV R1,@R2 ;YES IF WE GOT HERE BR 2$  LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; ; H.J., D.K. .MCALL CLOSE$ .IF DF F4P .MCALL DELET$,PRINT$ .ENDC ;DF F4P ;THIS ROUTINE CLOSES A FILE. THE DEVICE BLOCK AND - OTS$I ;PURE CODE SECTION $CKRCN:: MOV W.RECL(R3),R2 .IF DF F4P MOV W.RECH(R3),R1 BMI 1$ ;NEGATIVE RECORD IS NO GOOD BNE 4$ ;SO IS ZERO TST R2 BEQ 1$ 4$: TST D.RCN2(R0) ;IS THERE A RECORD LIMIT TO CHECK? BNE 3$ ;BRANCH IF YES TST D.RCNM(R0) ;CHECK OTHER HALF BEQ 2$ ;BRANCH FOR NO LIMIT 3$: CMP D.RCN2(R0),R1 BLT 1$ BGT 2$ .IFF BMI 1$ CLR R1 TST D.RCNM(R0) BEQ 2$ .ENDC CMP D.RCNM(R0),R2 BLO 1$ 2$: RTS PC 1$: ERROR BADRCN ;+ ; CALL BIT #DV.DFD,(R4) ;DIRECT? BEQ 16$ ;BRANCH IF NOT BIS #DV.UFP,(R4) ;DEFAULT FOR DIRECT IS UNFORMATTED BR 17$ 16$: BIS #DV.FMP,(R4) ;DEFAULT FOR SEQUENTIAL IS FORMATTED 17$: BIT #DV.FMP,(R4) ;IS THE FILE FORMATTED? BNE 20$ ;YES MOV F.RSIZ+D.FDB(R4),R2 ;GET THE RECORD SIZE IN UNITS!! ASL R2 ;CONVERT SIZE BVS 18$ ;BRANCH IF OVERFLOW ASL R2 ;TO BYTES. BVC 19$ ;BRANCH IF NO OVERFLOW 18$: ERROR DEFBIG ;RECORD SIZE TOO BIG INC R5 ;COUNT ERROR 19$: MOV R2,F.RSIZ+D.FDB(R4) ;AND REPL;GO INIT FPP ; ; COME HERE IF CFCC TRAPPED ; 1$: CMP (SP)+,(SP)+ ;DELETE TRAP PC & PSW MOV R1,@R2 ;RESTORE NORMAL TRAP ADDRESS MOVB #-1,W.FPPF(R3) ;SIGNAL NO FPP PRESENT BR FCS ;SKIP FPP INITIALIZATION 2$: .ENDC ;DF FPP&F4P .IF DF FPP ;+ ; FOR 11/45 WITH FPP, INITIALIZE THE FPP ; ASYNCHRONOUS TRAP, AND LOAD DEFAULT FPP STATUS ;- .MCALL SFPA$S SFPA$S #$FPERR BCS INITNG ;+ ; INITIAL FPP STATUS IS: ; INTERRUPT ON OVERFLOW AND INTEGER CONVERSION OVERFLOW ; NO INTER;ITS FDB ARE CLEARED. OTSWA FBLOCK ERRDEF ;ON ENTRY R2 CONTAINS THE LUN NO. OF THE FILE TO CLOSE OTS$I ;PURE CODE SECTION $CLOSE:: $AOTS ;GET WORK AREA ADDRESS JSR PC,$FCHNL ;GO GET ADDRESS OF DEV. BLOCK MOV R0,FILPTR(R3) ;SAVE DEVICE BLOCK ADDR FOR ERROR MOV R0,R1 ;KEEP DEV POINTER, ADD #D.FDB,R0 ;AND GET FDB ADDRESS FOR CLOSE$ TSTB @R1 ;IS FILE OPENED? BPL 4$ ;BRANCH IF NOT TO FREE LUN BIT #DV.CLO,@R1 ;IS CLOSE IN PROGERSS FOR FDB BNE 4$ ;YES - NO RECURSIVE CLOING SEQUENCE - $ASVAR ; ; R0 = FCS FDB ADDRESS ; R3 = WORK AREA ADDRESS ; JSR PC,$ASVAR ; R0,R3,R4,R5 = UNCHANGED ; R1,R2 = DESTROYED ;- .IF DF F4P $ASVAR:: MOV W.RECL(R3),R2 MOV D.AVAD-D.FDB(R0),R1 BEQ 1$ ;BRANCH IF NO ADDRESS TO USE BIT #DV.AI4,D.STA2-D.FDB(R0) BEQ 3$ ADD #1,R2 MOV R2,(R1)+ MOV W.RECH(R3),R2 ADC R2 BR 2$ 3$: INC R2 2$: MOV R2,@R1 1$: RTS PC .IFF $ASVAR:: MOV W.RECL(R3),R2 INC R2 MOV R2,@D.AVAD-D.FDB(R0) RTS PC .ENDC .END ACE IT IN THE FDB 20$: MOV R4,R2 ;GET ADD #D.STA2,R2 ;ADDRESS OF STATUS - WORD 2 BIT #DV.RDO,D.STA2(R4) ;IS WRITE ALLOWED? BEQ 1$ ;BRANCH IF YES, DON'T CHECK CONFLICTS BIT #DV.SPL!DV.DEL,(R2) ;IS IT TO BE SPOOLED OR DELETED? BEQ 5$ ;NO ERROR BDOPDE ;YES, CAN'T DO IT TO RO FILE INC R5 5$: BIT #DV.NEW!DV.SCR,(R2) ;IS IT NEW OR SCRATCH? BEQ 1$ ;NO, SO FAR SO GOOD ERROR BDOPRO ;NEW OR SCRATCH CANNOT BE READONLY INC R5 ;MARK ERROR 1$: BIT #DV.APD,(R2) ;IS IT APPEND? BEQ 3$ ;NO RUPT ON UNDERFLOW OR UNDEFINED VARIABLE ; ROUND RESULTS ;- LDFPS #1400 .ENDC ;DF FPP ;+ ; INITIALIZE FILE CONTROL SERVICES ;- .MCALL FINIT$ FCS: FINIT$ ; ; SET UP FOR ERROR MESSAGE HANDLING ; .IF DF F4P!RSXD .MCALL OFF$,GLUN$S GLUN$S W.MO(R3),W.ERLN(R3) CMP #"MO,@W.ERLN(R3) ;IS IT MO? BEQ 1$ ;BRANCH IF SO MOVB #1,W.MOTY(R3) ;USE TERMINAL MODE 1$: .ENDC ;DF F4P!RSXD .IF DF F4P RTS PC .ENDC .IF DF F4 ; ; SET UP INITIAL TRACE BACK BLOCK FOR MAIN PR SE$ BIS #DV.CLO,@R1 ;SET CLOSE IN PROGRESS FLAG .IF DF F4P BIT #DV.OPN,@R1 ;FILE OPEN? BEQ 4$ ;BRANCH IF NOT BIT #DV.DEL,D.STA2(R1) ;IS IT MARKED FOR DELETE? BEQ 1$ ;NO DELET$ R0 ;CLOSE AND DELETE THE FILE BR 3$ 1$: BIT #DV.SPL,D.STA2(R1) ;IS IT MARKED FOR SPOOL? BEQ 2$ ;NO PRINT$ R0 ;CLOSE AND PRINT IT BR 3$ .ENDC ;DF F4P 2$: CLOSE$ R0 ;CLOSE THE FILE 3$: BCC 4$ ;JUMP IF NO ERROR DETECTED ERROR NCLOSE ;CLOSE ERROR (FCS) MOV #-1,R2 ;SET ERROR RETURN BR 6$  .TITLE $OPEN -FILE OPEN AND DEFAULT NAME ROUTINES .IDENT /P06/ ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UN  BIT #DV.RDO,D.STA2(R4) ;IS IT ALSO READ ONLY? BNE 2$ ;BRANCH IF YES BIT #DV.NEW!DV.SCR,(R2) ;IS IT NEW OR SCRATCH? BEQ 3$ ;NO , ALL IS OK 2$: ERROR BDOPAP ;ILLEGAL APPEND INC R5 ;MARK ERROR 3$: BIT #DV.SCR,(R2) ;IS IT A SCRATCH FILE BEQ 4$ ;NO BIT #DV.SAV!DV.SPL,(R2) ;IS IT MARKED FOR SAVE OR SPOOL? BEQ 4$ ;NO ERROR BDOPSC ;CAN'T SAVE OR SPOOL A SCRATCH UNIT INC R5 ;MARK AS FATAL 4$: TST R5 ;ANY ERRORS SEEN? BNE ERJMP ;YES, DON'T ATTEMPT TO OPEN FILE. CALL SETATR ;GO OGRAM ; MOV W.MAIN(R3),R0 ;GET ADDR OF BLOCK MOV R0,W.NAMC(R3) ;LINK ONTO HEAD OF LIST CLR (R0)+ ;ZERO LINK AND SEQUENCE CLR @R0 MOV @R4,R4 ;FOR THREADED CONTINUE JMP @(R4)+ ;GO DO FORTRAN PROGRAM .ENDC ;DF F4 ; ; INITIALIZATION FAILURE EXIT ; INITNG: ERROR ERINIT JMP $EXIT$ .END 4$: CLR R2 ;SET NO ERROR RETURN MOV #,R0 ;LENGTH OF DEV BLOCK IN WORDS 5$: CLR (R1)+ ;CLEAR THE ENTIRE DEV BLOCK SOB R0,5$ ;LOOP UNTIL DONE 6$: CLR FILPTR(R3) ;RELEASE I/O SYSTEM ROR R2 ;SET C-BIT WITH ERROR CODE RTS PC ;RETURN .END DER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER 27-JUN-74 ; .GLOBL $OPEN ;ON ENTRY ; R0 CONTAINS ADDR OF LUN BLOCK ; R2 CONTAINS FORTRAN CHANNSET FILE ATTRIBUTES IN FDB MOV R4,R0 ;GET ADDRESS ADD #D.FDB,R0 ;OF THE FDB IN R0 MOV R4,R1 ;FOR $OPEN$ JSR PC,$OPEN$ ;USE COMMON OPEN LOGIC BCC EXIT ;EXIT IF NO ERROR ERJMP: TST R5 ;DON'T ATTEMPT CLOSE ON BMI 1$ ;CATASTROPHIC ERRORS (IE., LUN OUT OF RANGE) MOVB F.LUN+D.FDB(R4),R2 ;GET LUN FOR CLOSE BEQ 1$ ;ZERO MEANS CLOSED AT LOWER LEVEL JSR PC,$CLOSE ;DELETE ALL MEMORY OF THIS UNIT 1$: MOV ERREX(R3),(SP) ;SET ERROR TRANSFER FROM ERR= BNE EXIT ;AND EXIT IF PRESENT JMP $E .TITLE $ISF - INPUT SEQUENTIAL FORMATTED IDENT 03 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 17-JUN-74 ; ;+ ; FUNCTION: ; PROCESS SEQUENTIAL FORMATTED READ ; STATEMENTS. ; ; CALLING SEQUENCE: ; ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,ISF(E)$ ; ; RETURNS WITH ARGUMENTS DELETED AND ALL ; CONTEXT PRESERVED. ; ;- OTSWA FBLOCK OTS$I ISF$:: JSR PC,$SAVP2 MOV #FL.FMT!FL.RD,R1 .TITLE $ISU -SEQUENTIAL UNFORMATTED INPUT IDENT 07 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974, ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASEEL NUMBER ; R3 CONTAINS ADDR($AOTS) ; ---- N O T E ---- ; IF STRANGE REQUIREMENTS ARE NEEDED FOR THE OPEN, ; THEY MUST BE PLUGGED IN BY THE ROUTINE WHICH IDENTIFIES ; THE REQUEST. SPECIFICALLY ASSIGN, FDBSET AND DEFINEFILE. .MCALL FDRC$R,FDOP$R,OPEN$,FDAT$R OTSWA FBLOCK ERRDEF $OPEN:: JSR R5,.SAVR1 ;SAVE R1 TO R5 MOV R0,-(SP) MOV R0,R1 ;MAKE COPY OF LUN POINTER INTO R1 ADD #D.FDB,R0 ;POINT R0 TO FDB PROPER MOV #FD.RAN!FD.PLC,R4;SET DEFAULT I/O MODE TO LOCATE RANDOM BIT #DVRXIT ;NO, FATAL ERROR EXIT EXIT: CLR FILPTR(R3) ;NOW CLEAR THE FILE POINTER CLR ERREX(R3) ;ALSO CLEAR ERROR EXIT IF ANY CLRB W.IOEF(R3) ;AND ERROR RETURN FLAG RETURN ;AND EXIT IN A BLAZE OF GLORY .SBTTL SET FILE ACCESS ATTRIBUTES ; SETATR ; ; FUNCTION ; SET UP THE REQUIRED FILE ATTRIBUTES IN THE FACC AREA IN THE ; FDB. ; ; INPUTS ; R2 - ADDRESS OF D.STA2 ; R4 - LUN BLOCK POINTER ; ; OUTPUTS ; F.FACC IN THE FDB IS SET UP ; SETATR: CLR R0 ;SAVE WORK AREA BIT #DV.OLD, BR ISF ISFE$:: JSR PC,$SAVP4 MOV #FL.FMT!FL.ERR!FL.RD,R1 ISF: JSR PC,$INITIO MOV #GFMTRC,RECIO(R3) 2$: JMP $FIO GFMTRC: JSR PC,$GETS MOV F.NRBD+2(R0),R1 MOV R1,BLBUF(R3) MOV R1,LNBUF(R3) ADD F.NRBD(R0),R1 MOV R1,EOLBUF(R3) RTS PC .END R UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED FOR FORTRAN IV-PLUS BY R. BRENDER 28-JUN-74 OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION ; UNFOR.DFD,@R1 ;IS UNIT FOR RANDOM I/O? BNE 2$ ;BRANCH IF SO FDAT$R R0,#R.VAR,#FD.FTN;SET OPEN FOR SEQ AND CARRIAGE CONTROL BIC #FD.RAN,R4 ;CLEAR RANDOM ACCESSING BIT BR 9$ 2$: FDAT$R R0,#R.FIX,#FD.FTN 9$: FDRC$R R0,R4,W.BFAD(R3),W.BLEN(R3);FILL RECORD ACCESS SECTION BIT #DV.FACC,@R1 ;WAS FACC BYTE SET BY CALL ASSIGN? BNE 3$ ;BRANCH IF IT WAS BISB #FO.UPD,F.FACC(R0) ;SET UPDATED ACCESS AS DEFAULT TST @R1 ;OTHERWISE SEE IF THIS OPERATION IS R/W BPL 3$ ;BRANCH IF READ, DEFUALTS ARE CORR(R2) ;IS IT AN OLD FILE? BEQ 3$ ;NO BIT #DV.RDO,(R2) ;IS IT READ ONLY? BEQ 1$ ;NO BIS #FO.RD,R0 ;SET READ BR 5$ 1$: BIT #DV.APD,(R2) ;IS IT APPEND? BEQ 2$ ;NO BIS #FO.APD,R0 ;SET APPEND BR 5$ 2$: BIS #FO.UPD,R0 ;MUST BE OLD, RW BR 5$ 3$: BIT #DV.NEW,(R2) ;IS IT NEW? BEQ 4$ ;NO BIS #FO.WRT,R0 ;SET WRITE BR 5$ 4$: BIT #DV.SCR,(R2) ;IS IT SCRATCH? BEQ 5$ ;NO, IT MUST BE UNKNOWN BIS #FA.TMP!FO.WRT,R0 ;MARK TEMP + WRITE BIC #DV.DEL,(R2) ;DELETION ON CLOSE IS AUTOMATIC 5$ .TITLE $ORU -OUTPUT RANDOM UNFORMATTED IDENT 07 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; R. SCHAEFER 16 JUL 74, 17 JUL 74 ; ;+ ; FUNCTION: ; INITIATE AND COMPLETELY HANDLE ; RANDOM UNFORMATTED WRITE STATEMENT. ; ; CALLING SEQUENCE: ; ; PUSH ; PUSH ; PUSH (IF E ENTRY) ; PUSH (IF E ENTRY) ; JSR PC,ORU(E)$ ; ; RETURNS WITH ARGUMENTS DELETED, CONTEXT ; PRESERVED AND EXPECTING 1/0 TRANSMISSION ; CMATTED I/O USES AN INTERNAL RECORD SCHEME BEYOND ; THAT OF FCS TO ALLOW FOR "SPANNED RECORDS". ; 1ST BYTE - 1 IF START OF A NEW RECORD (UNUSED BUT KEPT) ; 2 IF END OF A RECORD ; 2ND BYTE - 0 ; REMAINDER OF RECORD IS DATA .IF DF F4P ISU$:: JSR PC,$SAVP1 MOV #FL.RD,R1 BR ISU ISUE$:: JSR PC,$SAVP3 MOV #FL.RD!FL.ERR,R1 ISU: JSR PC,$INITIO .ENDC .IF DF F4 IUR$:: CLR -(SP) ;FMTAD WORD JSR PC,$INITIO ;PERFORM I/O INITIALIZE .ENDC ;DF F4 JSR PC,@(R4)+ ;SET UP ECT BISB #FO.WRT,F.FACC(R0) ;SET CREATE NEW FILE 3$: BIT #DV.ASGN,@R1 ;WAS FILE NAME GIVEN IN ASSIGN? BNE ASGNDONE ;BRANCH TO SKIP DEFAULT FILENAME SETTER MOV R1,R4 ;DEVICE ADDR FOR $FLDEF JSR PC,$FLDEF ;SET DEFAULT NAME ASGNDONE: MOV #,R4 ;GET SIZE OF FILENAME BLOCK IN WORDS MOV R0,R3 ;MAKE COPY OF FDB ADDR, DESTROYS R3 ADD #F.FNB+S.FNB,R3 ;POINT TO END OF FNB PORTION OF FDB 1$: MOV -(R3),-(SP) ;MOVE DFNB TO STACK DEC R4 BNE 1$ ;****************************************: BISB R0,F.FACC+D.FDB(R4) ;SET THE ACCESS TYPE RETURN .SBTTL GET INTEGER PARAMETER VALUE ; GETVAL ; ; FUNCTION ; GET VALUE OF PARAMETER WHERE PARAMETER MAY BE ; INTEGER*2 VALUE (ARGTYP=1), ADDRESS OF INTEGER*2 ; VALUE (ARGTYP=2), OR ADDRESS OF INTEGER*4 ; VALUE (ARGTYP=3). ; ; INPUTS ; R5 - ADDRESS OF ARGUMENT PAIR ; ; OUTPUTS ; CONDITION CODES OF HIGH ORDER VALUE ; R0 - LOW ORDER VALUE ; R1 - HIGH ORDER VALUE ; GETVAL: CMPB 1(R5),#1 ;IS IT A SIMPLE VALUE? BNE 1$ ;NO ALLS TO FOLLOW. ; ;- OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION .IF DF F4P ORUE$:: JSR PC,$SAVP5 MOV #FL.REC!FL.WRT!FL.ERR,R1 BR ORU ORU$:: JSR PC,$SAVP3 .ENDC ;DF F4P .IF DF F4 IUW$:: .ENDC ;DF F4 MOV #FL.REC!FL.WRT,R1 ORU: JSR PC,$INITIO MOV #100000,R2 ;PAD RECORD WITH ZEROES JSR PC,$PUTRI MOV F.NRBD(R0),RACNT(R3) ;RECORD LENGTH MOV F.NRBD+2(R0),BLBUF(R3) ;RECORD ADDRESS JSR PC,@(R4)+ ;GET FIRST IOLIST ELEMENT 3$: $AOTS MOVB ITEMSZ+1(R3),R2 THREADED COROUTINE $AOTS ;RESET WORK AREA POINTER INTO R3 2$: JSR PC,GUNFRC ;START BY READING A RECORD 6$: MOVB ITEMSZ+1(R3),R2 ;GET NUMBER OF BYTES ITEM CAN HOLD MOV VARAD(R3),R1 ;GET ITS ADDRESS BNE 3$ ;BRANCH AS LONG AS LIST UNSATISFIED ; STRANGE PIECE OF CODE TO POSITION US AT NEXT RECORD TSTB UNFLGS(R3) ;ARE WE IN LAST PHYSICAL BLOCK OF RECRD BEQ 2$ ;BRANCH IF NOT RTS PC ;RETURN 4$: TSTB UNFLGS(R3) ;ARE WE IN LAST PHYSICAL BLOCK OF RECRD BEQ 5$ ;BRANCH IF NOT ERROR RECSM**** .MCALL OPEN$U,OPEN$W FDOP$R R0,,,SP ;FILL IN DFNB ADDRESS BIT #DV.DFD,-D.FDB(R0) ;TEMP FIX TO ALLOCATE SPACE BNE 6$ ;FOR NEW FILE OPEN$ BR 8$ 6$: MOV F.RSIZ(R0),R4 ;SAVE REQUESTED RECORD LENGTH OPEN$U BCC 7$ MOV F.ERR(R0),R2 ;GET ERROR STATUS BMI 8$ ;BRANCH IF "DIRECTIVE ERROR CMPB #IE.NSF,R2 ;FILE NOT FOUND? BNE ERROR ;BRANCH IF SOME OTHER ERROR OPEN$W ;CREATE FILE 7$: BCS 8$ CMP R4,F.RSIZ(R0) ;SAME AS REQUESTED? BEQ OKAY ;BRANCH SINCE ALL IS FINE ERROR E MOV 2(R5),R0 ;GET VALUE BR 2$ ; 1$: CMPB 1(R5),#2 ;IS IT ADDRESS OF I*2? BNE 3$ ;NO MOV @2(R5),R0 ;GET VALUE 2$: CLR R1 ;CLEAR HIGH ORDER RETURN 3$: MOV 2(R5),R1 ;GET ADDRESS OF I*4 VALUE MOV (R1)+,R0 ;GET LOW ORDER MOV (R1),R1 ;GET HIGH ORDER RETURN .END MOV VARAD(R3),R1 BNE 1$ JSR PC,$PUTR RTS PC 1$: DEC RACNT(R3) BMI 2$ MOVB (R1)+,@BLBUF(R3) INC BLBUF(R3) SOB R2,1$ ;LOOP ON VARIABLE SIZE JSR PC,@(SP)+ ;GET NEXT IOLIST ELEMENT BR 3$ 2$: ERROR RECBIG .END "L ;ISSUE RECORD TOO SMALL ERROR 5$: MOV R2,-(SP) ;SAVE NEEDED REGS MOV R1,-(SP) JSR PC,GUNFRC ;GET NEXT PHYSICAL RECORD MOV (SP)+,R1 ;RESTORE REGS MOV (SP)+,R2 3$: DEC UNCNT(R3) ;DID WE HIT END OF RECORD? BMI 4$ ;SEE IF MORE DATA IN NEXT PHYSICAL ONE MOVB @BLBUF(R3),(R1)+;INPUT A BYTE OF DATA INC BLBUF(R3) ;BUMP RECORD POINTER DEC R2 ;IS VARIABLE SATISFIED? BNE 3$ ;BRANCH IF NOT JSR PC,@(SP)+ ;GO GET NEXT VARIABLE IN LIST $AOTS ;RESTORE DIRTY POINTER BR 6$ ;LOOP ; ; IN#RLNAT ;RECORD LENGTH DOES NOT MATCH FILE ;*********************************************** 8$: BCC OKAY ;BRANCH IF ALL O.K. ERROR: MOV F.ERR(R0),R2 ;GET ERROR VALUE WORD BMI 3$ ;BRANCH IF "DIRECTIVE" ERROR CMPB #IE.NSF,R2 ;NO SUCH FILE ERROR? BNE 4$ ;BRANCH IF NOT ERROR NOSUCH ;NO SUCH FILE ERROR 4$: CMPB #IE.NBF,R2 ;NO ROOM IN FSR? BNE 5$ ;BRANCH IF DIFFERENT ERROR ERROR NBUFRM ;NO BUFFER SPACE AVAILABLE 5$: ERROR NOOPEN ;GENERAL OPEN FAILED ERROR 3$: CMPB #IE.HWR,R2 ;HANDLER M$ .TITLE $CLSCAL -FORTRAN CALLABLE CLOSE FILE SUBROUTINE IDENT 03 ;RFB 26-SEP-74 ; ; DISCLAIMER ; ; H. JACOBS 10-JUN-74 ; ;+ ; FUNCTION: ; FORTRAN CALLABLE SUBROUTINE TO CLOSE THE ; FILE ASSOCIATED WITH A GIVEN LUN. ; ; CALLING SEQUENCE: ; CALL CLOSE(LUN) ; ; WHERE: ; LUN IS THE LOGICAL UNIT NUMBER. ; ;- ERRDEF OTS$I ;PURE CODE SECTION CLOSE:: CMPB #1,(R5)+ ;CORRECT # OF ARGS? BEQ 1$ ;YES - CLOSE FILE ERROR NOARGS ;WRONG # OF ARGS RTS PC 1$: INC R5 ;POINT TO ARG % .TITLE $OSF -OUTPUT SEQUENTIAL FORMATTED IDENT 03 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHAS&TERNAL RECORD HANDLING ; GUNFRC: JSR PC,$GETS ;GET A PHYSICAL RECORD MOV F.NRBD+2(R0),R1 ;GET THE ADDRESS OF THE RECORD MOV #-1,UNFLGS(R3) ;SET UNFORMATTED FLAGS WORD NEGATIVE BITB #2,(R1)+ ;IS THIS THE LAST PHYSICAL RECORD OF ;THE LOGICAL RECORD BNE 1$ ;BRANCH IF IT IS CLRB UNFLGS(R3) ;LOW BYTE 0 MEANS RECORD CONTINUES DEC D.RCCT-D.FDB(R0);REDUCE RECORD COUNT TO LOGICAL RATHER ;THAN PHYSICAL 1$: INC R1 ;POINT R1 TO 3ND BYTE OF RECORD MOV R1,BLBUF(R3) ;SET START OF DATA POI'ISSING? BNE 5$ ;USE CATCH ALL ERROR ERROR NDEVLD ;HANDLER TASK NOT RESIDENT ERROR OKAY: ADD #S.FNB,SP ;REMOVE DFNB FROM STACK BIS #DV.OPN,@R1 ;TELL WORLD THIS FILE IS OPENED MOV (SP)+,R0 RTS PC ;RETURN ;+ ; FUNCTION: ; CONSTRUCT DEFAULT FILE NAME IN FILE NAME BLOCK ; PORTION OF THE FDB. THE NAME IS OF THE FORM ; 'FOR0NN.DAT' WHERE NN IS THE LOGICAL UNIT NUMBER. ; ; INPUTS: ; R3 - WORK AREA POINTER ; R4 - DEVICE TABLE POINTER ; ; OUTPUTS: ; NONE. ; ALL REGISTERS PRESERVED. MOV @(R5)+,R2 ;PICK UP LUN JMP $CLOSE ;GO CLOSE LUN'S FILE ; .END )ER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER FOR FORTRAN IV-PLUS 30-JUN-74 OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION .IF DF NTER MOV F.NRBD(R0),R1 ;GET SIZE OF PHYSICAL RECORD SUB #2,R1 ;REMOVE FLAGS BYTE SIZE (NO CMPB -1,-1) MOV R1,UNCNT(R3) ;SET COUNT FOR MAIN SECTION RTS PC ;RETURN .END +;- ; RADIX-50 CHARATER CODES USED HEREIN: R50.A ='A-100 R50.D ='D-100 R50.F ='F-100 R50.O ='O-100 R50.R ='R-100 R50.T ='T-100 R50.0 =36 $FLDEF:: JSR R5,.SAVR1 ;FCSREGISTER SAVE COROUTINE MOVB F.LUN+D.FDB(R4),R2 ;GET LUN CLR R1 1$: SUB #10.,R2 BMI 2$ INC R1 BR 1$ 2$: ADD #10.,R2 ;LOW DIGIT IN R2 ;HIGH DIGIT IN R1 ADD #R50.0,R1 ;MAKE RAD50 DIGIT .IF DF EIS!FIS!FPP MUL #40.,R1 ;TIMES 40. .IFF MOV R1,R5 ASL R1 ASL R1 ADD R5,R1 ASL R1 ASL R1 ASL, .TITLE $OSU -OUTPUT SEQUENTIAL UNFORMATTED IDENT 07 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974, ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHAS-F4P OSF$:: JSR PC,$SAVP2 MOV #FL.FMT!FL.WRT,R1 BR OSF OSFE$:: JSR PC,$SAVP4 MOV #FL.FMT!FL.WRT!FL.ERR,R1 OSF: JSR PC,$INITIO .ENDC ;DF F4P .IF DF F4 IFW$: JSR PC,$INITIO ;INITIALIZE UNIT BPL 1$ ;BRANCH IF UNOPENED UNIT TST @R0 ;WAS LAST OPERATION READ? BMI 1$ ;BRANCH IF WRITE MOV F.URBD+2+D.FDB(R0),F.NRBD+2+D.FDB(R0) ;FOR CASE OF READ,WRITE MAKE WRITE USE ;USER RECORD BUFFER 1$: BIS #DV.FMP!DV.RW,@R0 ;SET FORMATTED WRITE JSR PC,@(SP)+ ;RETURN TO COMPLETE OPEN . .TITLE $REWIND -REWIND STATMENT PROCESSOR IDENT 04 ;RFB 25-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER R1 .ENDC ;DF EIS!FIS!FPP ADD #,R1 ;RAD50 '0 0' ADD R2,R1 ;GIVES 2ND HALF OF FILE NAME MOV R1,N.FNAM+2+F.FNB+D.FDB(R4) ;PUT RAD50 'FOR' IN NAME FIELD MOV #<+R50.O>*40.+R50.R,N.FNAM+F.FNB+D.FDB(R4) ;PUT RAD50 'DAT' IN TYPE FIELD MOV #<+R50.A>*50+R50.T,N.FTYP+F.FNB+D.FDB(R4) RTS PC .END 0ER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; MODIFIED BY R. BRENDER FOR FORTRAN IV-PLUS 26-JUN-74 OTSWA ERRDEF FBLOCK OTS$I ;PURE CODE SECTION ; UNFORM1IF NEEDED .ENDC ;DF F4 MOV #PFMTRC,RECIO(R3);SET RECORD HANDLER ADDR FOR FIO MOV #$FIO,-(SP) ;SIMULATE JSR FROM $FIO BR SETPUT ;BRANCH TO SET UP RECORD POINTERS PFMTRC: MOV BLBUF(R3),R1 ;GET END OF RECORD POINTER SUB LNBUF(R3),R1 ;SUBTRACT START OF RECORD TO GET SIZE JSR PC,$PUTS ;OUTPUT THE RECORD MOV FILPTR(R3),R0 ;REGET LUN ADDR SETPUT: MOV F.NRBD+2+D.FDB(R0),R1;GET ADDR OF WHERE NEXT RECORD GO MOV R1,BLBUF(R3) ;INIT CURRENT POINTER FOR $FIO MOV R1,LNBUF(R3) ;INIT START OF RE2 UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION .IF DF F4P REWI$:: JSR PC,$SAVP1 MOV @R0,R2 ;GET UNIT NUMBE .TITLE $EXIT - CALL EXIT ROUTINE IDENT 02 ;RFB 26-SEP-74 ; ; DISCLAIMER ; ; H. JACOBS 10-JUN-74 ; ;+ ; FUNCTION: ; FORTRAN CALLABLE SUBROUTINE TO TRANSFER CONTROL ; TO $EXIT, WHICH CLOSES ALL FILES AND EXITS TO MONITOR. ; ; CALLING SEQUENCE: ; CALL EXIT ; ;- OTS$I ;PURE CODE SECTION EXIT:: JMP $EXIT ;GO TO EXIT PROCESSING ; .END 4ATTED I/O USES AN INTERNAL RECORD SCHEME BEYOND ; THAT OF FCS TO ALLOW FOR "SPANNED RECORDS". ; 1ST BYTE - 1 IF START OF A NEW RECORD (UNUSED BUT KEPT) ; 2 IF END OF A RECORD ; 2ND BYTE - 0 ; REMAINDER OF RECORD IS DATA .IF DF F4P OSU$:: JSR PC,$SAVP1 MOV #FL.WRT,R1 BR OSU OSUE$:: JSR PC,$SAVP3 MOV #FL.WRT!FL.ERR,R1 OSU: JSR PC,$INITIO .ENDC ;DF F4P .IF DF F4 IUW$:: CLR -(SP) ;FMTAD WORD MOV #FL.WRT,R1 JSR PC,$INITIO ;PERFORM I/O INITIALIZE .ENDC ;DF F4 CORD POINTER ADD W.BLEN(R3),R1 ;CREATE END OF RECORD ADDRESS MOV R1,EOLBUF(R3) ;SET FOR $FIO RTS PC ;RETURN .END 6R .IFF RWD$:: MOV @(SP)+,R2 ;GET UNIT NUMBER .ENDC JSR PC,$GETFILE ;GET FDB ADDRESS BPL 2$ ;BRANCH IF FILE NOT OPENED, NOP BIT #DV.DFD,@R0 ;IS FILE RANDOM ACCESS? BNE 2$ ;BRANCH IF SO TO IGNORE REWIND BIC #DV.APD,D.STA2(R0) ;CLEAR APPEND FLAG - ;I.E., BACKSPACE IS NOW OKAY CLR D.RCCT(R0) ;CLEAR RECORD COUNTER ADD #D.FDB,R0 ;POINT TO FCS FDB PART CLR R1 ;SET UP ARGS FOR POINT MOV #1,R2 ;VIRTUAL BLOCK 1 CLR R3 ;BYTE 0 JSR PC,.POINT BCC 2$ ;BRANCH IF NO ERROR 7 .TITLE $FIO -FORMAT EXECUTER IDENT 10 ;RFB 29-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UNDER A LICE8 JSR PC,@(R4)+ ;SET UP THREADED COROUTINE $AOTS ;RESET WORK AREA POINTER INTO R3 JSR PC,SETPUT ;SET PUT POINTERS INCB @F.NRBD+2+D.FDB(R0) ;SET LOGICAL RECORD STARTS FLAG 4$: MOVB ITEMSZ+1(R3),R2 ;GET NUMBER OF BYTES ITEM CAN HOLD MOV VARAD(R3),R1 ;GET ITS ADDRESS BEQ ENDPUT ;OUTPUT LAST PIECE OF LOGICAL RECORD 2$: DEC UNCNT(R3) ;ARE WE OUT OF SPACE IN PHYSICAL RECORD BGE 3$ ;BRANCH IF NOT CLR UNCNT(R3) ;MAKE UNCNT REFLECT MAXIMUM RECORD SIZE MOV R2,-(SP) ;SAVE NEEDED REGS MOV R1,-9 .TITLE $SAVRG - REGISTER SAVE/RESTORE CO-ROUTINE IDENT 04 ;RFB 25-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 29-MAY-74 ; ENTRY $SVFPP ADDED 16-AUG-74 ; ;+ ; FUNCTION: ; CO-ROUTINE TO- ; 1) SAVE ALL REGISTERS ON STACK, ; 2) SET UP R0 TO POINT TO LAST OF STACK ARGS ; PASSED TO CALLER BY HIS CALLER, ; 3) CONTINUE WITH CALLER, ; 4) ON RETURN, RESTORE ALL REGISTERS, ; 5) DELETE STACK ARGS ; 6) AND MAKE ULTIMATE RETURN TO CALLERS CALLER. ; ; DISTINCT ENTRIES ARE PROVIDED FOR EACH NUMBER OF STA CMP #,F.ERR(R0) ;END-OF-FILE IS OKAY, ;(I.E., FILE IS EMPTY) BEQ 2$ ERROR REWIND 2$: $AOTS CLR FILPTR(R3) ;SIGNAL I/O INACTIVE $NEXT$ .END ;NSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; ; H.J. FOR FORTRAN IV/RT-11/RSX11M ; MODIFIED BY R.BRENDER FOR FORTRAN IV-PLUS 16-JUN-74 ; FEATURES ADDED: ; 1) I*4 HANDLING ; 2) VARIABL<(SP) JSR PC,DOPUT ;OUTPUT THIS PART OF THE LOGICAL RECORD DEC D.RCCT-D.FDB(R0);KEEP LOGICAL RECORD COUNT,NOT PHYSICAL JSR PC,SETPUT ;SET UP FOR NEXT RECORD MOV (SP)+,R1 ;RESTORE REGS MOV (SP)+,R2 BR 2$ ;BRANCH BACK TO DECREMENT COUNT 3$: MOVB (R1)+,@BLBUF(R3);OUTPUT A BYTE OF DATA INC BLBUF(R3) ;BUMP RECORD POINTER SOB R2,2$ ;LOOP TIL VARIABLE SATISFIED JSR PC,@(SP)+ ;GO GET NEXT VARIABLE IN LIST $AOTS ;RESTORE DIRTY POINTER BR 4$ ;LOOP SETPUT: MOV FILPTR(R3),R0 ;GET ADDR OF =CK ; STACK ARGUMENTS FROM 0 TO 6, EG., $SAVP0, $SAVP1, ETC. ; ; TO MAKE A NON-STANDARD RETURN TO AN ADDRESS OTHER THAN ; THE CALLERS CALLERS CALL: ; MOV ,R0 ; JMP $SAVPX ; RATHER THAN ; RTS PC ; ; TO HANDLE A VARIABLE NUMBER OF ARGUMENTS, USE $SAVP0 ; AT ROUTINE ENTRY, AND RETURN WITH: ; MOV ,R0 ; JMP $SAVPC ; ;- OTSWA F0 =%0 ;FPP REGISTER NAMES F1 =%1 F2 =%2 F3 =%3 F4 =%4 F5 =%5 OTS$I ;PURE CODE SECTION $SAVP0:: MOV #4,-(SP)> .TITLE $GETR -GET RAMDOM RECORD IDENT 03 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; ;+ ; FUNCTION: ; $GET - GET A RAMDOM ACCESS RECORD AND ; SET UP OTSWA POINTERS TO IT. ; ; CALLING SEQUENCE: ; ; JSR PC,$GETR ; ; (THE RECORD NUMBER COMES FROM W. RECL AND ; W. RECH OF OTSWA.) ;- OTSWA ERRDEF FBLOCK .MCALL GET$R OTS$I ;PURE CODE SECTION $GETR:: $AOTS MOV FILPTR(R3),R0 JSR PC,$CKRCN ADD #D.FDB,R0 GET$R R0,,,R2,R1 BCC 1$ ERROR BADGET 1$: JSR PC,$A?E FORMAT EXPRESSIONS .GLOBL $FIO .GLOBL DCO$,RCI$,GCO$,FCO$,ECO$ .GLOBL ICI$,ICO$,LCI$,LCO$,OCI$,OCO$ ;THIS IS THE FORMAT INTERPRETER, IT ACTS AS A COROUTINE WITH ;THE I/O TRANSMIT OPERATORS. IT ONLY ACCEPTS A PSEUDO COMPILED FORM OF ;THE FORMAT STATEMENT AS INPUT (GENERATED BY THE COMPILER). ;ENTRY INTO THIS ROUTINE IS IN ITS MIDDLE FOR BRANCHES OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION ; ; SERVICE ROUTINES TO GET A FORMAT BYTE. ; IF A VARIABLE FORMAT EXPRESSION @LUN MOV F.NRBD+2+D.FDB(R0),R1 ;GET PLACE TO PUT NEXT RECORD ;+ ; MAXIMUM PHYSICAL RECORD SIZE IS LIMITED SO THAT ; UNFORMATTED RECORDS CAN ALWAYS BE READ BY ANY ; TASK USING DEFAULT 'MAXBUF' INDEPENDENT OF 'MAXBUF' ; VALUE OF WRITING TASK. THE LARGEST VALUE THAT FITS IN ; 133. BYTES AND IS STILL A DIVISOR OF 512. (THE DISK BLOCK ; SIZE IN BYTES) IS 128. ALLOWING 2 BYTES FOR THE ; FCS RECORD LENGTH COUNT LEAVES 126. ;- MOV #126.,UNCNT(R3) ;SET MAX PHYSICAL RECORD SIZE CLRB (R1)A ;STACK ADJUSTMENT VALUE FOR BR S ;ZERO ARGS $SAVP1:: MOV #6.,-(SP) ;FOR ONE ARG BR S $SAVP2:: MOV #8.,-(SP) ;ETC BR S $SAVP3:: MOV #10.,-(SP) BR S $SAVP4:: MOV #12.,-(SP) BR S $SAVP5:: MOV #14.,-(SP) BR S $SAVP6:: MOV #16.,-(SP) ; ; COMMON CODE ; S: MOV R0,-(SP) ;SAVE R0 MOV SP,R0 ;SET R0 TO CALLERS ADD #8.,R0 ;CALLERS LAST ARG MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV 12.(SP),-(SP) ;COPY DOWN CONTINUATION ADDR MOV R5,14.(SP) ;PUT R5 WHSVAR RTS PC .END CIS INDICATED ; ITS VALUE IS CHECKED FOR VALID RANGE. ; .IF DF F4 GFMTW: GFMTCT: GFMTCR: GFMTSV: .ENDC ;DF F4 ; ; GET A BYTE FROM THE FORMAT ITSELF ; GFMTBY: CLR R1 ;RETURN BYTE HERE BISB @FMTAD(R3),R1 ;NOT SIGN EXTENDED INC FMTAD(R3) ;BUMP POINTER RTS PC .IF DF F4P ; ; GET A VARIABLE FORMAT EXPRESSION ; GFMTVE: MOV R0,-(SP) ;SAVE CONTEXT MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) JSR PC,$SVFPP ;CO-ROUTINE TO SAVE FPP STATE MOV FMTAD(R3),R0 ;GET F+ ;FIRST BYTE OF UNFORMATTED RECORD IS 0 CLRB (R1)+ ;INIT 2ND BYTE FOR LATER SUB #2,UNCNT(R3) ;GOTTA REDUCE COUNT BY 2 MOV R1,BLBUF(R3) ;SET START OF RECORD POINTER RTS PC ;RETURN ENDPUT: MOV FILPTR(R3),R0 ;GET ADDRESS OF LUN BISB #2,@F.NRBD+2+D.FDB(R0) ;SET END OF LOGICAL RECORD INDICATOR DOPUT: MOV FILPTR(R3),R0 ;GET ADDRESS OF LUN MOV #126.,R1 ;CALCULATE SIZE OF RECORD SUB UNCNT(R3),R1 ;PUT ACTUAL SIZE IN R1 JMP $PUTS ;OUTPUT THE RECORD .END EERE IT CAME FROM JSR PC,@(SP)+ ;LINK BACK TO CALLER MOV (SP)+,R4 ;RESTORE SEQUENCE MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 MOV SP,R5 ;CALC WHERE TO PUT RETURN ADD @SP,R5 ;ADDRESS(OVER FIRST ARG) MOV 4(SP),@R5 ;PUT IT THERE MOV 2(SP),R5 ;THE LAST REG ADD @SP,SP ;FLUSH ARGS RTS PC ;AND EXIT ; ; ABNORMAL RETURN ; $SAVPX:: MOV R0,16.(SP) ;OVERWRITE RETURN ADDR RTS PC ;AND DO NORMAL UNWIND ; ; VARIABLE NUMBER OF ARGUMENTS EXIT ; $SAVPC:: ASL R0 ;MAKE F .TITLE $GETS -GET A SEQUENTIAL RECORD IDENT 02 ;RFB 29-SEP-74 ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITaL EQUIPMENT CORTORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PURCHASER UNDGORMAT ADDRESS INC R0 ;ROUND TO NEXT WORD BIC #1,R0 MOV (R0)+,R1 ;GET VFE ADDRESS MOV R0,FMTAD(R3) ;UPDATE FORMAT POINTER MOV W.R5(R3),R5 ;RESTORE R5 CONTEXT AT I/O ENTRY JSR PC,@R1 ;INVOKE VFE MOV R0,R1 ;PUT RETURN VALUE WHERE NEEDED JSR PC,@(SP)+ ;RETURN TO $SVFPP TO RESTORE FPP STATE MOV (SP)+,R5 ;RESORE REST OF STATE MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R0 RTS PC ; ; GET A REPEAT COUNT ; REPEAT COUNTS ARE EXPECTED TO BE ONE LESS THAN THE WRITTEN ; VAH .TITLE $IOELEM - I/O ELEMENT TRANSMISSION IDENT 06 ;RFB 29-SEP-74 ; ; ;THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ;NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ;EQUIPMENT CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO ;RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. ; ;THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER ;UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE ;COPIED (WITH INCLUSION OF DIGITALIARG COUNT TO WORD COUNT ADD R0,12.(SP) ;ADD TO STACK ADJUST WORD RTS PC ;DO RETURN ;+ ; FUNCTION: ; TO SAVE AND RESORE FPP REGISTER CONTENTS. ; ; CALLING SEQUENCE: ; ; JSR PC,$SVFPP ;TO SAVE FPP STATE ; ;RETURNS AS A CO-ROUTINE WITH FPP ; ;STATE ON THE STACK ; ; JSR PC,@(SP)+ ;TO RESTORE FPP STATE ; ;- $SVFPP:: $AOTS -(SP) ;OTSWA ADDRESS ADD #W.FPPF,@SP ;MAKE ADDR OF FPP PRESENT FLAG TSTB @(SP)+ ;IS IT? BNE 1$ ;BRANCH IF NOT STFPS -(SP) ;FLOATINF STATUS REGISTERJER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ;GET A RECORD ROUTINE, RETURNS A RECORD. .MCALL GET$S OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION $GETS:: MKLUE FOR INTERNAL USE. ; GFMTCT: ASLB W.PNTY(R3) ;USE VFE? BCC GFMTBY ;BRANCH IF NOT GFMTC1: JSR PC,GFMTVE ;EVALUATE EXPRESSION DEC R1 ;DECREMENT FOR INTERNAL USE CMP #254.,R1 ;CHECK VALID RANGE BHI 1$ ;BRANCH IF OKAY ERROR ERVFEV ;VFE VALUE BAD CLR R1 ;SUBSTITUTE VALUE 1$: RTS PC ; ; GET A FIELD WIDTH ; MUST BE IN RANGE 1 TO 255. ; GFMTW: ASLB W.PNTY(R3) ;A VFE? BCC GFMTBY ;BRANCH IF NOT JSR PC,GFMTC1 ;USE COUNT GETTER INC R1 ;BUT DIS-ADJUST THE VALUE RTS PC ; ; L'S COPYRIGHT NOTICE) ;ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED ;IN WRITING BY DIGITAL. ; ;DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE ;OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED ;BY DIGITAL. ; ;COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION ; ;R. BRENDER 15-JUN-74 ; ;+ ;FUNCTION: ; TRANSMIT THE ADDRESS OR VALUE IN ; AN I/O LIST TO THE RECORD PROCESSING ; ROUTINES. ; ;CALLING SEQUENCE: ; (BY ADDRESS - USED FOR IM SETD ;TO SAVE ENTIRE REGISTER CONTENTS STD F0,-(SP) ;SAVE, ... STD F1,-(SP) STD F2,-(SP) STD F3,-(SP) LDD F4,F3 STD F3,-(SP) LDD F5,F3 STD F3,-(SP) MOV 50.(SP),-(SP) ;CO-ROUTINE LINK BACK ADDRESS 1$: JSR PC,@(SP)+ ;DO IT $AOTS -(SP) ;MUST RETEST FPP PRESENT ADD #W.FPPF,@SP TSTB @(SP)+ ;IS IT? BNE 2$ ;BRANCH IF NOT MOV (SP)+,50.(SP) ;MOVE BACK RETURN ADDRESS SETD ;TO DOUBLE MODE AGAIN LDD (SP)+,F3 ;RESTORE ... STD F3,F5 LDD (SP)+,F3 STD F3,F4 LDD (SP)+,F3 NOV FILPTR(R3),R0 ;GET PTR TO LUN ADD #D.FDB,R0 ;CREATE POINTER TO FDB GET$S R0 ;READ THE NEXT RECORD BCC 1$ ;BRANCH IF ALL O.K. MOV F.ERR(R0),R1 ;SEE IF FCS ERROR? BMI 2$ ;NEGATIVE MEANS NO CMPB #IE.EOF,R1 ;IS ERROR END OF FILE? BNE 2$ ;BRANCH IF NOT END OF FILE 5$: MOV ENDEX(R3),R4 ;DOES AN END= ADDRESS EXIST? BNE 3$ ;BRANCH IF END= GIVEN ERROR ENDERR ;ISSUE END OF FILE ERROR 3$: JMP $IOEXIT ;USE $EOL EXIT CODE 2$: ERROR BADGET ;ISSUE GET RECORD FAILED ERROR 1$: INC D.RCCT-O GET A COUNT THAT IS IN THE RANGE 0 TO 255. ; GFMTCR: ASLB W.PNTY(R3) ;A VFE? BCC GFMTBY ;BRANCH IF NOT JSR PC,GFMTVE ;EVALUATE VFE CMP #255.,R1 ;CHECK RANGE BHI 1$ ;BRANCH IF OKAY ERROR ERVFEV MOV #1,R1 1$: RTS PC ; ; GET A SIGNED VALUE IN THE RANGE -128. TO 127 ; GFMTSV: ASLB W.PNTY(R3) ;A VFE? BCC GFMTBY ;BRANCH IF NOT JSR PC,GFMTVE ;EVALUATE VFE MOV R1,-(SP) TSTB @SP ;SET N-BIT SXT R1 CMPB R1,1(SP) BEQ 1$ ;BRANCH IF OKAY ERROR ERVFEV 1$: CLR R1 BISB (SP)+,RPNPUT AND OUTPUT) ; ; PUSH ; JSR PC,$IOA(B,I,J,L,M,R,D,C, OR H) ; ; WHERE THE FINAL LETTER IS THE ELEMENT ; DATA TYPE ; ; (BY VALUE - USED ONLY FOR OUTPUT) ; ; PUSH (1,2, OR 4 WORDS) ; JSR PC,$IOV(B,I,J,L,M,R,D,OR C) ; ; RETURNS WITH ARGUMENTS DELETED AND CONTEXT PRESERVED ; ;- ADBDEF OTSWA .LIST MEB ; ;SINCE THE PROCESSING IS SO REGULAR THE ;MANY ENTRY POINTS ARE GENERATED BY ;THE FOLLOWING MACRO IN WHICH ; T IS THE DATA TYPE CODE LETTER ; W IS THE NUMBER OF WO LDD (SP)+,F2 LDD (SP)+,F1 LDD (SP)+,F0 LDFPS (SP)+ ;RESTORE INCOMING STATUS 2$: RTS PC ;RETURN .END D.FDB(R0);BUMP RECORD COUNT FOR BACKSPACE CMP #1,F.NRBD(R0) ;IS THIS A SPECIAL RECORD? BNE 4$ ;BRANCH IF NOT CMPB #'Z-100,@F.NRBD+2(R0) ;IS RECORD 1 BYTE ^Z? BEQ 5$ ;SIMULATE END OF FILE 4$: RTS PC ;RETURN .END S1 RTS PC .ENDC ;DF F4P ;GET NEXT BYTE FROM RECORD ROUTINE GETBYT: CMP BLBUF(R3),EOLBUF(R3) ;MORE CHARS IN RECORD? BLO 1$ ;BRANCH IF YES MOVB #' ,R0 ;RETURN A BLANK FOR THIS CASE RTS PC ;RETURN 1$: MOVB @BLBUF(R3),R0 ;GET NEXT CHAR IN RECORD INTO R0 BR BUMPTR ;GO TO BUMP CURRENT CHARACTER POINTER ;OUTPUT A BLANK INTO RECORD ROUTINE, FALLS INTO PUT BYTE OBLANK: MOVB #' ,R0 ;PUT CHARACTER IN R0 FOR PUTBYT ;OUTPUT A CHARACTER INTO RECORD ROUTINE, FALLS INTO NXTBYT PUTBYT: CMTRDS ON THE ; I/O CALL STACK FOR THE BY VALUE ENTRY ; B IS THE NUMBER OF BYTES PER ELEMENT ; FOR THE DATA TYPE ; VT IS THE DATA TYPE CODE ; .MACRO IO T,W,B,VT IOA'T'$:: JSR PC,$SAVP1 ;CONTEXT SAVE MOV @R0,R0 ;ADDR TO R0 BR IO'T IOV'T'$:: JSR PC,$SAVP'W ;CONTEXT SAVE IO'T: MOV #<256.*B+B>,R1 ;ELEMENT SIZE MOV #VT,R2 ;VARIABLE TYPE CODE BR IOCOM ;JUMP TO COMMON CODE .ENDM ;IO ; ; THE COMMON CODE ; IOCOM: $AOTS MOV SP,FMTCLN(R3) ;FOR END=/ERR= TRANSFERS MOV R0,VARAD(RU .TITLE $OTV OTS IMPURE AREAS IDENT 08 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; H. JACOBS ; ; MODIFIED BY: ; R. BRENDER 27-MAY-74 ; ;+ ; FUNCTION: ; ALLOCATES THE IMPURE WORKING ; AREAS REQUIRED BY THE FORTRAN OBJECT ; TIME SYSTEM. ; ;- FBLOCK NOFCS ERRDEF .LIST MEB ; ; NOTE: ; THE FOLLOWING GLOBAL REFERENCE IS NEEDED UNDER RSX11D V4A ; TO CAUSE THE MODULE $OTVHL TO BE LOADED. $OTVHL INITIALIZES ; THE TO 'LOW CORE' POINTER TO THE OTS WORK AREA THAT ; IS REFERENCED BY THE MACROV .TITLE $OTVHLP -POINTER TO $OTSVA IDENT 02 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 23-JUN-74 ; ;+ ; FUNCTION: ; USED UNDER RSX11D V4A TO INITIALIZE TO LOW CORE ; POINTER TO THE OTS WORK AREA. THIS POINTER IS ; USED BY ALL OTS ROUTINES TO OBTAIN ADDRESSABILITY ; TO THE IMPURE AREA IN A REENTRANT MANNER. ; ; (UNDER RSX11D V6A AND RSX11M THIS IS HANDLED AUTOMATICALLY ; BY TKB AND THIS MODULE IS NOT NEEDED OR LOADED. INDEED, ; UNDER RSX11M THE LOW CORE POINTER LOCATION IS NOT AT ; THE WP BLBUF(R3),EOLBUF(R3) ;MORE ROOM IN RECORD? BLO 1$ ;BRANCH IF THERE IS ERROR RECBIG ;TELL USER OVERFLOWED RECORD BUFFER RTS PC ;RETURN AS NOP IF ERROR NON-FATAL 1$: MOVB R0,@BLBUF(R3) ;PUT CHARACTER IN RECORD BUMPTR: INC BLBUF(R3) ;BUMP TO NEXT BYTE OF RECORD RTS PC ;RETURN TO CALLER ;WRITE A RECORD ROUTINE DOWRT: CMP BLBUF(R3),TSPECP(R3) ;THE BIGGER IS THE END OF RECORD BHIS 2$ ;BRANCH IF BLBUF IS FARTHER INTO RECORD MOV TSPECP(R3),BLBUF(R3) ;MAKE BLBUF BIGGEST 2$: CLR TSPECP(R3)X3) ;VARIABLE ADDRESS MOV R1,ITEMSZ(R3) ;ITEM SIZE MOV R2,W.VTYP(R3) ;VARIABLE TYPE JSR PC,@W.EXJ(R3) ;CALL RECORD ROUTINE $AOTS MOV (SP)+,W.EXJ(R3) ;SAVE CONTINUATION RTS PC OTS$I ;PURE CODE SECTION ; ;BYTE(LOGICAL *1) ; IO B,1,1,A.LGC1 ; ;LOGICAL *2 ; IO L,1,2,A.LGC2 ; ;LOGICAL *4 ; IO M,2,4,A.LGC4 ; ;INTEGER *2 ; IO I,1,2,A.INT2 ; ;INTEGER *4 ; IO J,2,4,A.INT4 ; ;REAL ; IO R,2,4,A.REA4 ; ;DOUBLE PRECISION ; IO D,4,8.,A.REA8 ; ;COMPLEX ; IOAC$:: JY $AOTS. THIS INITIALIZATION ; IS HANDLED AUTOMATICLY BY RSX11D V6A AND RSX11M. ; .IF DF RSXD .IF NDF RSXDV6 .GLOBL $OTSV .ENDC .ENDC ; ; OTS WORK AREA ; .PSECT $$AOTS,D $ALOC$ =1 ;CAUSES OTSWA TO ALLOCATE STORAGE .BLKW 20. ;SYSTEM DIRECTIVE SUBR WORK AREA $OTSVA:: OTSWA ;ALLOCATE NAMED PART OF WORK AREA ; ; PART OF WORK AREA THAT IS NOT COVERED BY NAMED OFFSETS ; MAIN: +0,0 ;INITIAL TRACEBACK BLOCK FOR F4 .RAD50 /.MAIN./ IOSTAT: .BLKW 2 ;IO STATUS BLOCK USED BY QSAME LOCATION AS IN RSX11D, HENCE THE REASON FOR ; TKB TO HANDLE AND COMPENSATE. ;- .ASECT . =4 $OTSV:: +$OTSVA .END [ ;ALWAYS CLEAR TSPECP FOR NEXT TIME TST DOLFLG(R3) ;WAS DOLLAR FORMAT ENCOUNTERED? BEQ 1$ ;BRANCH IF NOT ;IF FIRST CHAR IS A BLANK THEN SUBSTITUE $ CMPB #' ,@LNBUF(R3) BNE 3$ MOVB #'$,@LNBUF(R3) ;IF FIRST CHAR IS + THEN SUBSTITUTE A NULL 3$: CMPB #'+,@LNBUF(R3) BNE 1$ CLRB @LNBUF(R3) 1$: JSR PC,@RECIO(R3) ;OUTPUT ENTIRE RECORD CLR DOLFLG(R3) ;CLEAR DOLLAR FLAG ARET: RTS PC ;RETURN TO (SLASH,EOFMT) ;T FORMAT PROCESSOR TFMT: JSR PC,GFMTW ;GET POSITION ADD LNBUF(R3),R1 ;GET POINTE\SR PC,$SAVP1 MOV @R0,R0 BR IOC IOVC$:: JSR PC,$SAVP4 IOC: $AOTS MOV #<4*256.+4>,ITEMSZ(R3) MOV #A.REA4,W.VTYP(R3) MOV R0,VARAD(R3) MOV SP,FMTCLN(R3) JSR PC,@W.EXJ(R3) $AOTS ADD #4,VARAD(R3) JSR PC,@(SP)+ $AOTS MOV (SP)+,W.EXJ(R3) RTS PC ; ;HOLLERITH ; IOAH$:: JSR PC,$SAVP1 MOV @R0,R1 ;ADDRESS OF ASCIZ STRING MOV #-1,R2 ;COUNTER 1$: INC R2 ;MUST SCAN TO DETERMINE TSTB (R1)+ ;LENGTH BNE 1$ $AOTS MOV @R0,VARAD(R3) MOVB R2,ITEMSZ+1(R3) MOVB R2,ITEMSZ(R3) ]IOS ; ; WARNING! ; THE FOLLOWING THREE DECLARATIONS MUST BE TOGETHER. ; ; ROUTINE ERRPT DOES A GTSK$ MACRO TO GET THE TASK NAME ; FOR THE ERROR REPORT. THIS MACRO REQUIRES A 16 WORD ; BUFFER OF WHICH THE FIRST TWO ARE THE TASK NAME. ; THE REMAINDER ARE ALLOWED TO OVERFLOW INTO THE ERROR ; LINE BUFFER, WHICH MUST THEREFORE BE AT LEAST 14 ; WORDS LONG. ; TSKNAM: .BLKW 2 ;TASK NAME IN RAD50 ERRLIN: .IF DF RSXM .BLKB 60. ;ERROR TEXT LINE .IFF .BLKB 110. ;ERROR TEXT LINE^ .TITLE $PUTR -PUT RANDOM RECORD IDENT 06 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 19-JUN-74 ; ;+ ; FUNCTION: ; $PUTRI - SET UP FOR RANDOM ACCESS WRITE ; BY POSITIONING FILE AND SETTING ; UP OTSWA RECORD POINTERS. ; ; $PUTR - WRITE A RANDOM ACCESS RECORD. ; ; CALLING SEQUENCE: ; ; JSR PC,$PUTR(I) ; ; (RECORD NUMBER IS OBTAINED FROM ; W.RECL AND W.RECH OF OTSWA.) ; ;- OTSWA ERRDEF FBLOCK .MCALL PUT$R OTS$I ;PURE CODE SECTION $PUTRI:: MOV R2,-(SP) ;SAVE PA_R TO WANTED POSITION DEC R1 ;TO FIX R1 NOT IN DECREMENTED MODE CMP BLBUF(R3),TSPECP(R3) ;IS WE PAST MAX SAVED POSITION? BLOS 1$ ;BRANCH IF BEFORE LAST T FMT MOV BLBUF(R3),TSPECP(R3) ;SAVE IF PAST LAST T AS NEW T 1$: CMP TSPECP(R3),EOLBUF(R3) ;PAST END OF BUFFER? BLOS 2$ ;BRANCH IF NOT ERROR RECSML ;RECORD TO SMALL FOR I/O MOV EOLBUF(R3),TSPECP(R3) ;BACK UP TSPECP TO END OF BUFFER BR 3$ ;CONTINUE 2$: MOV R1,R2 ;SAVE WHERE WE SHOULD BE SUB TSPECP(R3),R1 ;IS MAX PTR INTO RECORD BEFO MOV #A.HOLL,W.VTYP(R3) JSR PC,@W.EXJ(R3) $AOTS MOV (SP)+,W.EXJ(R3) RTS PC ; .END a .ENDC ERREND: .BLKB 10. ;ERROR LINE OVERFLOW ERRTAB: .BLKB ERMAXN-ERCLS0+1 ;ERROR CONTROL TABLES .EVEN ; ; SYNCHRONOUS SYSTEM TRAP ADDRESS TABLE ; $SST:: +$SST0 ;ODD ADDRESS +$SST1 ;SEGMENT FAULT (MAPPED SYSTEMS ONLY) +$SST2 ;T-BIT OR BPT +$SST3 ;IOT +$SST4 ;RESERVED INSTRUCTION +$SST5 ;NON-RSX EMT +$SST6 ;TRAP TRAP +$SST7 ;11/40 FIS TRAP ; ; DEVICE TABLE ; .PSECT $$DEVT,OVR,D DEVTAB: F.FDB==S.FDB+D.FDB ;USED BY TKM TO EXTEND $$DEVT ; ; FILE STORAGE bD CODE MOV FILPTR(R3),R0 JSR PC,$CKRCN ADD #D.FDB,R0 .IF DF F4P MOV R1,F.RCNM(R0) .ENDC MOV R2,F.RCNM+2(R0) JSR PC,.POSRC BCC PUTRET ;BRANCH IF ALL CLEAR CMPB #IE.EOF,F.ERR(R0) ;BEYOND ALLOCATED STORAGE? BEQ PUTEOF ;THEN BRANCH TO IGNORE PUTERR: ERROR BADPUT PUTEOF: MOVB #1,F.ERR(R0) ;CLEAR ERROR CODE PUTRET: TST @SP ;PAD WANTED? BPL 1$ ;BRANCH IF NOT MOV F.NRBD+2(R0),R1 ;RECORD START MOV F.NRBD(R0),R2 ;LENGTH IN BYTES 2$: MOVB @SP,(R1)+ ;PUT IN THE PAD SOB R2,2$ cRE DESIRED? BGT TXFMT ;BRANCH IF IT IS TO BLANK DIFFERENCE MOV R2,BLBUF(R3) ;SET NEW CURRENT POSITION 3$: BR FINTRT ;INTERPRET NEXT BYTE ;OPEN PARENTHESIS PROCESSOR LPAREN: MOV FSTKP(R3),R2 ;GET PTR TO FREE SPOT ON STACK MOV R1,(R2)+ ;SAVE REPEAT COUNT MOV FMTAD(R3),(R2)+ ;SAVE BACKUP PTR LPEXT: MOV R2,FSTKP(R3) ;SAVE NEW FORMAT STACK PTR BR FINTRT ;INTERPRET NEXT BYTE ;CLOSE PARENTHESIS PROCESSOR RPAREN: MOV FSTKP(R3),R2 ;GET CURRENT PTR MOV -(R2),R0 ;GET PREVIOUS FORMAT RETURN Pd .TITLE $PUTS -SEQUENTIAL RECORD PUT TO FCS IDENT 03 ;RFB 29-SEP-74 ; ; ; ; ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS 01754 ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT ; BY DIGITAL EQUIPMENT CORPORATION. DIGITAL EQUIPMENT ; CORPORATION ASSUMES NO RESPONSIBILITY FOR ANY ERRORS ; THAT MAY APPEAR IN THIS DOCUMENT. ; ; THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO ; THE PUeREGION ; .MCALL FSRSZ$ FSRSZ$ 0 ;0 SIZE FOR TKB TO EXTEND ; F.BFHD==S.BFHD ;USED BY TKB TO EXTEND FSR ; ; I/O BUFFER AREA ; .PSECT $$IOB1,OVR,D DFRECL=132. ;DEFAULT RECORD SIZE IOBFAD: .BLKB DFRECL ;DEFAULT SIZE - CAN BE INCREADED ;AT TASK BUILD TIME .PSECT $$IOB2,OVR,D IOBFND: ; ; WORK AREA FOR COMPILATION OF OBJCT TIME FORMATS ; .PSECT $$OBF1,OVR,D OBFL: .BLKW 32. ;DEFAULT SIZE - EXTENDABLE ;BY FMTBUF TKB OPTION .PSECT $$OBF2 OBFH: ;END OF FORMAT AREA .E ;LOOP IF MORE 1$: TST (SP)+ ;DISCARD PAD CODE RTS PC $PUTR:: $AOTS MOV FILPTR(R3),R0 ADD #D.FDB,R0 PUT$R BCC 1$ ERROR BADPUT 1$: JSR PC,$ASVAR ;UPDATE ASSOCIATED VARIABLE RTS PC .END gTR DEC -(R2) ;DECREMENT REPEAT COUNT BMI LPEXT ;BRANCH IF REPEAT COUNT EXPIRED TO POP MOV R0,FMTAD(R3) ;SET FORMAT PTR TO BEGINING OF ITERATION BR FINTRP ;INTERPRET NEXT BYTE ;P FORMAT PROCESSOR PFMT: JSR PC,GFMTSV ;GET SIGNED VALUE MOVB R1,R1 ;SIGN EXTEND COUNT BYTE MOV R1,PSCALE(R3) ;TREAT COUNT BYTE AS P SCALE FACTOR BR FINTRP ;GO TO INTERPRET NEXT BYTE ;X FORMAT PROCESSOR, ALSO HANDLES TRAILING BLANKS FOR T FORMAT XRD: JSR PC,GETBYT ;READ X FMT, GET NEXT BYTE FROM RECORD hRCHASER UNDER A LICENSE FOR USE ON A SINGLE COMPUTER ; SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S ; COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS ; MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; THAT IS NOT SUPPLIED BY DIGITAL. ; ; H.J. ; ;THIS ROUTINE OUTPUTS A RECORD TO A FILE. ;OUTPUT OCCURS IN 2 MODES, EITHER AS IS MODE OR FORTRAN LISTING ;MODE ND j .TITLE FDBSET -FCS FDB SPECIAL FUNCTIONS SETUP IDENT 05 ;RFB 23-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 4-AUG-74 ; OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION FDBSET:: MOV (R5)+,R4 ;NUMBER OF ARGS MOV @(R5)+,R2 ;LUN $AOTS MOVB #1,W.IOEF(R3) ;FLAG RETURN ON ERROR JSR PC,$GETFILE ;LOOK UP FDB BPL ACCESS ;DON'T TOUCH OPEN FILE ERROR FILOPN BR EXITR ACCESS: JSR PC,GETARG ;GET NEXT ARG BEQ SHARE ;BRANCH IF NULL MOV #CTAB,R1 ;SET UP TO SEARCH LIST 12$: CMPB (R1)+,kTXFMT: DEC R1 ;DECREMENT REPEAT COUNT BMI FINTRP ;BRANCH IF NO MORE XFMT: TST @FILPTR(R3) ;IS IT READ OR WRITE BPL XRD ;BRANCH IF ITS READ JSR PC,OBLANK ;OUTPUT A BLANK BR TXFMT ;LOOP UNTIL COUNT EXPIRED ;SLASH PROCESSOR, USES END OF FORMAT PROCESSOR FOR OUTPUT SLASH: TST DENCWD(R3) ;ALLOWED? BEQ 2$ ;BRANCH IF OKAY ERROR ERMLTR ;MULTIPLE RECORDS NOT ALLOWED 2$: TST @FILPTR(R3) ;IS IT READ OR WRITE? BPL 1$ ;BRANCH IF READ JSR PC,DOWRT ;GO WRITE RECORD BR FINTRP ;INTERPRET l ; THIS IS DETERMINED AT OPEN TIME. THE DEFAULT IS LISTING MODE ; ;ON ENTRY: ; R3 CONTAINS ADDR($AOTS) ; R1 CONTAINS LENGTH OF RECORD ; R3,R4,R5 ARE SACRED .MCALL PUT$S OTSWA FBLOCK ERRDEF OTS$I ;PURE CODE SECTION $PUTS:: MOV FILPTR(R3),R0 ;GET ADDR OF LUN ADD #D.FDB,R0 ;POINT TO FDB SECTION PUT$S R0,,R1 ;OUTPUT THE RECORD BCC 1$ ;BRANCH IF NO ERROR INDICATION ERROR BADPUT ;PUT RECORD FAILURE ERROR 1$: INC D.RCCT-D.FDB(R0);BUMP RECORD COUNT RTS PC ;RETURN TO CALLEm .TITLE $FPERR -FPP AST HANDLER IDENT 03 ;RFB 23-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 1-AUG-74 ; ;+ ; FUNCTION: ; HANDLE 11/45 FPP ASYNCHRONOUS TRAPS AND TRANSLATE TO ; FORTRAN ERROR REPORTS. ; ; ALL ERRORS AS INDICATED IN THE FPP FLOATING ; EXCEPTION CODE (FEC) REGISTER ARE REPORTED. ; ADDITIONAL ERROR SPECIFIC HANDLING CONSISTS OF: ; ; FEC=4 -FLOATING DIVIDE BY ZERO ; THE VALUE IN THE FLOATING REGISTER IS ; REPLACED BY ZERO (0.0) ; ; FEC=8 -FLOATING OVERFLOW ; SAME AS FLOATINn@R2 ;IS IT THIS ONE BEQ 11$ ;BRANCH IF WE GOT IT ADD #3,R1 ;POINT TO NEXT ENTRY TSTB @R1 ;SEE IF AT END OF LIST? BNE 12$ ;BRANCH IF NOT BR ERR ;REPORT ERROR 11$: MOVB (R1)+,F.FACC+D.FDB(R0) ;SET ACCESS TYPE BIS #DV.FACC,@R0 ;FLAG ACCESS BYTE EXPLICITLY SET BIS (R1),D.STA2(R0) ;SET OTHER I/O FLAGS SHARE: JSR PC,GETARG ;GET ARG 'SHARED' BEQ MULBUF ;BRANCH IF NULL CMPB #'S,@R2 ;MAKE SURE 'S' BNE ERR ;BRANCH FOR ERROR BISB #FA.SHR,F.FACC+D.FDB(R0) ;SET SHARED ACCESS BIT MUoNEXT BYTE 1$: JSR PC,@RECIO(R3) ;READ NEXT RECORD FINTRT: BR FINTRP ;INTERPRET NEXT BYTE .IF DF F4P ;COLON PROCESSOR, CONTINUE ONLY IF MORE IN I/O LIST COLON: JSR PC,@(SP)+ ;ANOTHER LIST ITEM? $AOTS TST VARAD(R3) BEQ RETURN ;BRANCH TO EXIT HANDLING BR FINTRP ;KEEP GOING .ENDC ;DF F4P ;H FORMAT PROCESSOR, NOTE QUOTED STRINGS ARE CONVERTED TO H FORMAT HFMT: MOV R1,R2 ;KEEP COUNT IN R2 BR 2$ ;JUMP INTO ROUTINE 3$: JSR PC,GETBYT ;FOR READS GETS BYTE FROM RECORD MOVB R0,@FMTAR .END qG DIVIDE BY ZERO. ; ; FEC=10 -FLOATING UNDERFLOW ; SAME AS FLOATING DIVIDE BY ZERO. ; (NOTE THAT UNDERFLOW IS NOT NORMALLY ENABLED ; BUT MAY BECOME ENABLED BY THE ERRSET ROUTINE.) ; ; CALLING SEQUENCE: ; FPP ASYNCHRONOUS TRAP. ; ;- ERRDEF OTSWA .MCALL ASTX$S ; ; FLOATING REGISTER NAME DEFINITIONS ; F0=%0 F1=%1 F2=%2 F3=%3 OTS$I ;PURE CODE SECTION $FPERR:: MOV R1,-(SP) ;SAVE R1 MOV 2(SP),R1 ;GET FPP EXCEPTION ADDRESS MOV R0,2(SP) ;SAVE R0 STFPS R0 ;GErLBUF: JSR PC,GETARG ;GET MULTIPLE BUFFER COUNT BEQ INITSZ ;BRANCH IF NULL MOVB @R2,F.MBCT+D.FDB(R0) ;SET IT IN FDB INITSZ: JSR PC,GETARG ;INITIAL ALLOCATION SIZE BEQ EXTEND ;BRANCH IF NONE MOV @R2,F.CNTG+D.FDB(R0) ;SET INTO FDB EXTEND: JSR PC,GETARG ;GET EXTEND SIZE BEQ NAMBLK ;BRANCH IF NONE MOV @R2,F.ALOC+D.FDB(R0) ;SET INTO FDB NAMBLK: JSR PC,GETARG ;NAME BLOCK IMAGE? BEQ EXITR ;BRANCH IF NONE BIS #DV.FNB,@R0 ;DECLARE NAME BLOCK INITIALIZED MOV #S.FNBW,R1 ;SIZE OF NAME BLsD(R3) ;INSERT BYTE INTO H STRING INC FMTAD(R3) ;BUMP TO NEXT BYTE 1$: DEC R2 ;IS COUNT EXPIRED BMI FINTRP ;BRANCH IF COUNT DONE 2$: TST @FILPTR(R3) ;IS IT READ OR WRITE? BPL 3$ ;BRANCH IF READ JSR PC,GFMTCR ;GET NEXT FORMAT BYTE MOV R1,R0 ;PUT IN R0 FOR PUTBYT JSR PC,PUTBYT ;OUTPUT THE BYTE BR 1$ ;GO CHECK COUNT ;END OF FORMAT CHARACTER FOUND EOFMT: MOV FMTRET(R3),FMTAD(R3) ;RESET INTERPRETER POSITION RETURN: TST @FILPTR(R3) ;IS IT READ OR WRITE? BPL 1$ ;BRANCH IF READ JSR Pt .TITLE $ERRSNS -SENSE LAST RUN TIME ERROR DATA IDENT 05 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 9-JUN-74 ; ;+ ; FUNCTION: ; SENSE AND RETURN TO USER DATA ON THE LAST ; ERROR TO OCCUR. ; ; CALLING SEQUENCE: ; CALL ERRSNS(NUM,FERR,FER1,UNIT) ; ; WHERE: ; NUM IS THE ERROR NUMBER, ; FERR IS THE FCS F.ERR BYTE IF NEGATIVE, ; FER1 IS THE FCS F.ERR+1 BYTE IF F.ERR IS NEGATIVE, AND ; UNIT IS THE LOGICAL UNIT NUMBER. ; ; ALL ARGUMENTS ARE TYPE INTEGER*2. ; ANY NUMBER OF ARGUMENTS MAY BuT FPP STATUS BIC #100000,R0 ;CLEAR INTERRUPT FLAG LDFPS R0 ;RESTORE TO STATUS REG $AOTS R0 ;OTS WORK AREA ADDR MOV R1,W.PC(R0) ;SAVE ADDR FOR ERROR REPORT MOV 4(SP),R0 ;EXCEPTION CODE ASL R0 ;ADJUST FOR JMP FLT(R0) ;DISPATCH TO REPORT ERROR ; ; TABLE OF SPECIFIC ERROR REPORTS ; EACH ENTRY CONTINUES TO ERROR SPECIFIC CODE ; FLT: ERROR ERFP00 ;CAN'T HAPPEN? BR EXIT 2$: ERROR ERFP02 ;OPCODE ERROR BR EXIT 4$: ERROR FZDIV ;DIVIDE BY ZERO BR VALZER 6$: ERROR ERFLIN ;FvOCK IN WORDS ADD #F.FNB+D.FDB,R0 ;ADDR OF NAME BLOCK 1$: MOV (R2)+,(R0)+ ;COPY IN NAME BLOCK SOB R1,1$ ;LOOP TIL ALL COPIED EXITR: CLRB W.IOEF(R3) ;CLEAR I/O ERROR HANDLING FLAG CLR FILPTR(R3) ;FREE UP I/O SYSTEM RTS PC ;WHEW! ERR: ERROR BADARG ;INVALID ARGUMENT BR EXITR GETARG: DECB R4 ;DECRMENT ARG CPUNT BLE DONE ;DONE WHEN WE HIT 0 (OR LESS??) GETCNT: MOV (R5)+,R2 ;GET ADDRESS OF NEXT ARG CMP #-1,R2 ;SET CONDITION CODE FOR NULL ARGS RTS PC ;RETURN DONE: TST (SP)+ ;REwC,DOWRT ;WRITE THE CURRENT RECORD 1$: TST VARAD(R3) ;ANY MORE DATA? BEQ ARET ;RETURN TO CALLER (SLASH,EOL$) TST DENCWD(R3) ;MORE RECORDS ALLOWED? BEQ 2$ ;BRANCH IF OKAY ERROR ERMLTR ;MULTIPLE RECORDS NOT ALLOWED 2$: TST FMTLP(R3) ;SEE IF WE ARE IN A FORMAT LOOP? BNE EORENT ;BRANCH IF DATA ITEM TRANSMITTED ERROR INFRMT ;ISSUE ERROR (INFINITE LOOP) ;DOLLAR FORMAT PROCESSOR DOLLAR: MOV SP,DOLFLG(R3) ;SET DOLLAR FLAG, IGNORED ON INPUT BR FINTRP ;INTERPRET NEXT BYTE ;Q FORMAT PROCExE SPECIFIED. ; ;- OTSWA OTS$I ;PURE CODE SECTION ERRSNS:: $AOTS MOV #TABOFF,R1 ;TABLE OF OFFSETS MOVB (R5)+,R0 ;ARG COUNT BEQ 5$ ;EXIT IF NONE INC R5 ;KEEP R5 EVEN 2$: MOVB (R1)+,R2 ;GET OFFSET BEQ 1$ ;BRANCH IF NO MORE BIC #177400,R2 ;CLEAR ANY SIGN EXTEND ADD R3,R2 ;MAKE A WORK AREA ADDRESS CMP #-1,@R5 ;CHECK FOR NULL ARG BEQ 4$ ;BRANCH IF NULL MOV @R2,@(R5)+ ;SEND VALUE TO CALLER 4$: CLR @R2 ;CLEAR USED UP VALUE SOB R0,2$ ;LOOP IF MORE ARGS 5$: MOVB (R1yLOATING TO INTEGER OVERFLOW BR EXIT 8$: ERROR FOVRFL ;OVERFLOW BR VALZER 10$: ERROR FUNDFL ;UNDERFLOW BR VALZER 12$: ERROR ERFP12 ;UNDEFINED VALUE BR EXIT 14$: ERROR ERFP14 ;MAINTENANCE BR EXIT ; ; ERROR SPECIFIC ACTIONS ; VALZER: MOV @R1,R0 ;GET INSTRUCTION AT TIME OF ERROR ASH #-4,R0 ;SHIFT FOR DISPATCH AND BIC #177763,R0 ;EXTRACT REGISTER JMP CLRF0(R0) ;DISPATCH ; ; TABLE OF REGISTER SPECIFIC CLEAR INSTRUCTIONS. ; NOTE THAT AC 4 AND 5 CANNOT BE DESTINATION AT THE MOVE SUBR RETURN ADDRESS BR EXITR ;FREE I/O SYSTEM AND EXIT OTS$D ;PURE CODE SECTION CTAB: .BYTE 'N,FO.WRT ;'NEW' CREATE .WORD DV.NEW .BYTE 'O,FO.UPD ;'OLD' UPDATE .WORD DV.OLD .BYTE 'R,FO.RD ;'RDO' READ ONLY .WORD DV.OLD!DV.RDO .BYTE 'A,FO.APD ;'APPEND' .WORD DV.OLD!DV.APD .BYTE 'M,FO.MFY ;'MODIFY' .WORD DV.OLD .BYTE 'I,FO.WRT!FA.NSP;'INSUP' INHIBIT SUBERSEDE .WORD DV.NEW .BYTE 'U,FO.UPD ;'UNKNOWN' .WORD DV.UNK!DV.OLD .WORD 0 .EVEN .END {SSOR QFMT: TST VARAD(R3) ;MAKE SURE ANOTHER VARIABLE BEQ RETURN ;BRANCH IF AT END OF LIST TST @FILPTR(R3) ;INPUT OR OUTPUT? BMI 1$ ;IGNORE ON OUTPUT MOV EOLBUF(R3),R2 ;CALCULATE NUMBER OF CHARS IN BUFFER SUB BLBUF(R3),R2 ;(REMAINING IN BUFFER) MOV R2,@VARAD(R3) ;PUT IT IN VARIABLE, DOESN'T CHECK TYPE .IF DF F4P CMPB #4,ITEMSZ(R3) ; *4 VARIABLE? BNE 1$ ;BRANCH IF NOT MOV VARAD(R3),R2 CLR 2(R2) ;SET HIGH ORDER .ENDC ;DF F4P 1$: JSR PC,@(SP)+ ;GET NEXT VARIABLE $AOTS )+,R2 ;CLEAR REMAINING WORK AREA VALUES BEQ 1$ ;BRANCH IF DONE BIC #177400,R2 ;CLEAR ANY SIGN EXTEND ADD R3,R2 CLR @R2 BR 5$ 1$: RTS PC OTS$D ;PURE DATA SECTION TABOFF: .BYTE W.ERNM,W.FERR,W.FER1 .BYTE W.ERUN,0 .EVEN .END ; TIME OF ANY FPP ERRORS. ALSO THE F/D MODE MODE IS ; ALWAYS CORRECT AT THE TIME OF AN FPP TRAP. ; CLRF0: CLRF F0 ;OR CLRD F0 BR EXIT CLRF1: CLRF F1 BR EXIT CLRF2: CLRF F2 BR EXIT CLRF3: CLRF F3 ; ; COMMON EXIT FOR ALL EXCEPTION CONDITIONS ; EXIT: MOV (SP)+,R1 ;RESTORE R1 MOV (SP)+,R0 ;RESTORE R0 TST (SP)+ ;DISCARD EXCEPTION CODE ASTX$S ;EXIT FPP AST .END ~ .TITLE $STPPAU STOP AND PAUSE MODULE IDENT 08 ;RFB 26-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 27-MAY-74 ; ; MODIFIED BY: ; B. LEAVITT 29-MAY-74 ; ;+ ; FUNCTION: ; PROCESS STOP AND PAUSE STATEMENTS. ; ALSO INTERNAL $EXIT ROUTINE. ;- OTSWA FBLOCK .MCALL SPND$S OTS$I ;PURE CODE SECTION .IF DF F4P STOP$:: JSR PC,$SAVP1 MOV R0,R4 ;POINTER TO POINTER TO TEXT MOV #TXTSTP,R0 ;STOP TEXT ADDRESS JSR PC,STPPAU BR $EXIT PAUS$:: JSR PC,$SAVP1 MOV R0,R4 ;POINTER TO PO ;JUST IN CASE BR FINTRP ;INTERPRET NEXT BYTE $FIO: CLR PSCALE(R3) ;CLEAR P SCALE FACTOR CLR DOLFLG(R3) ;CLEAR DOLLAR FORMAT FLAG JSR PC,@(R4)+ ;GO BACK TO GET FIRST DATA ITEM $AOTS ;RESTORE R3 EORENT: CLR TSPECP(R3) ;CLEAR T FORMAT PTR TST @FILPTR(R3) ;CHECK FOR READ OR WRITE? BMI TPLVL ;BRANCH IF WRITE JSR PC,@RECIO(R3) ;READ FIRST RECORD FOR READS TPLVL: MOV R3,FSTKP(R3) ;INITIALIZE FSTKP ADD #FSTK,FSTKP(R3) ;TO CONTAIN ;POINTER TO FORMAT STACK AREA, OPEN USES THIS ;ARE .TITLE $ERRPT - ERROR REPORTING MODULE IDENT 25 ;RFB 30-SEP-74 ; ;DISCLAIMER ; ; R. BRENDER 26-MAY-74 ; ;+ ; FUNCTION: ; REPORT RUN TIME ERRORS. ; ;- OTSWA FBLOCK .MCALL GTSK$S,SVTK$,DIR$,EXIT$S LF =12 ;ASCII LINE FEED CHARACTER CR =15 ;ASCII CARRIAGE RETURN CHARACTER .LIST MEB ; ; TRAP VECTOR ENTRIES ; $SST0:: MOV #ERSST0,R0 BR SSTCOM $SST1:: ADD #6,SP ;DISCARD SEGMENT DATA INFO MOV #ERSST1,R0 BR SSTCOM $SST2:: MOV #ERSST2,R0 ;T-BIT OR BPT BR SSTCOM $SST3; FILE ERRASM.CMD ; ; INDIRECT COMMAND FILE TO ASSEMBLE ERROR MODULES ; DK1:[300,121]ERRMO ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERRMO DK1:[300,121]ERRPT ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERRPT DK1:[300,121]ERRSET,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERRSET DK1:[300,121]ERRSNS,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERRSNS DK1:[300,121]ERRTST,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERRTST DK1:[300,121]ERTXT ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]ERTXT DK1:[300,121]FPERR ,LP:=DK1:[100,INTER ... MOV #TXTPAU,R0 JSR PC,STPPAU SPND$S ;SUSPEND TASK RTS PC .ENDC ;DF F4P .IF DF F4 BAH$:: MOV #TXTPAU,R0 JSR PC,STPPAU PSE$:: SPND$S JMP @(R4)+ FOO$:: MOV #TXTSTP,R0 JSR PC,STPPAU STP$:: BR $EXIT .ENDC ;DF F4 ; ; COMMON CODE FOR STOP AND PAUSE. ; BUILDS AND PUTS OUT THE MESSAGE ; STPPAU: $AOTS MOV R4,-(SP) ;SAVE THREADED PTR MOV R0,-(SP) ;SAVE STOP/PAUSE TEXT POINTER JSR PC,$ERRZA ;SETS UP TASK NAME, ETC. MOV (SP)+,R1 ;"STOP" OR "PAUSE" POINTEA BUT NOT AT SAME TIME. MOV FMTAD(R3),FMTRET(R3) ;SAVE FORMAT RETURN PTR CLR FMTLP(R3) ;INITIALIZE FORMAT LOOP FLAG ;FALL INTO INTERPRETER LOOP FINTRP: CLR R2 ;FOR GENERAL USE BY ROUTINES JSR PC,GFMTBY ;GET NEXT CHAR IN R1 .IF DF F4P BIT #100,R1 ;IS POINTY BRACKET FLAG SET? BEQ 3$ ;BRANCH IF NOT MOVB @FMTAD(R3),W.PNTY(R3) ;NEXT BYTE IS FLAG BYTE INC FMTAD(R3) ;STEP FMT POINTER 3$: .ENDC ;DF F4P ;JUST LIKE BEFORE MOVB R1,R0 ;SAVE OPCODE AND CHECK SIGN BMI 1$ ;BRANCH:: MOV #ERSST3,R0 ;IOT BR SSTCOM $SST4:: MOV #ERSST4,R0 ;RESERVED INSTRUCTION BR SSTCOM $SST5:: MOV #ERSST5,R0 ;NON-RSX EMT SST6: TST (SP)+ ;DISCARD EXTRA WORD ; ; $SST6 AND $SST7 ARE ON FOLLOWING PAGES ; ; ; SOMETHING IS VERY WRONG! ; TRY TO GIVE ERROR MESSAGE AFTER DISABLING ; ANY FURTHER SST TRAPS, INCLUDING NORMAL ERROR TRAPS. ; SSTCOM: SUB #ERCLS0,R0 ;MAP ERROR NUMBER INTO USER RANGE $AOTS ;WORK AREA ADDRESS MOV @SP,W.PC(R3) ;SAVE PC FOR ERROR REPORT DIR$ #SVTK JSR 110]RSXD,FPP,F4P,[300,120]FPERR DK1:[300,121]R50 ,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]R50 DK1:[300,121]STPPAU,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]STPPAU DK1:[300,121]USEREX,LP:=DK1:[100,110]RSXD,FPP,F4P,[300,120]USEREX ; ; ALTERNATE FORMS ; ; NOTE: ERRMO11M MUST BE ASSEMBLED UNDER RSX11M TO GET ; NEW QIO FORMATS. ; DK1:[300,122]ERRMO11M ,LP:=DK1:[100,110]RSXM ,FPP,F4P,[300,120]ERRMO DK1:[300,122]ERRPTDV6 ,LP:=DK1:[100,110]RSXDV6,FPP,F4P,[300,120]ERRPT DK1:[300,122]ERRPT11MR JSR PC,$FILL ;FILL IT IN MOV (SP)+,R4 ;RESTORE THREADED POINTER MOV (R4)+,R1 ;USER TEXT ALSO JSR PC,$FILL ;FILL IT IN JSR PC,$DET1L ;OUTPUT TEXT RTS PC ; ; CLOSE ALL FILES AND EXIT TO MONITOR ; EXIT$:: $EXIT:: $AOTS MOV W.DEV(R3),R5 ;ADDR OF DEV TABLES ADD #F.LUN+D.FDB,R5 ;POINT TO FIRST LUN NUMBER MOV W.LUNS(R3),R4 ;NUMBER OF LUNS 1$: MOVB @R5,R2 ;LUN NUMBER FOR CLOSE BEQ 2$ ;SKIP IF EMPTY JSR PC,$CLOSE 2$: ADD #F.FDB,R5 ;POINT TO NEXT F.LUN BYTE SOB R4,1$ ;LOOP IF MO IF COUNT PRESENT CLR R1 ;ZERO COUNT (COUNT IS KEPT -1) BR 2$ 1$: JSR PC,GFMTCT ;GET COUNT FIELD INTO R1 2$: BIC #177700,R0 ;GET RID OF FLAG BITS CLRB W.DFLT(R3) ;CLEAR DEFAULT FORMAT FLAG JMP @DISPTB(R0) ;GO OFF TO APPROPRIATE ROUTINE ; ; THE ERROR CODES FROM FMTCV DISPATCH TO HERE ; FMTBAD: ERROR OBJBAD BR LSTLOP ;UNLIKELY BUT JUST IN CASE FMTBIG: ERROR OBJBIG ;FORMAT OVERFLOWED BUFFER LSTLOP: TST VARAD(R3) ;VARIABLE PRESENT BEQ EOFMT ;BRANCH TO WIND UP IF SO JSR PC,@(SP)+ ;RPC,$ERRAA ; ; THESE ERRORS SHOULD NOT RETURN BUT ; JUST IN CASE... ; ; THIS IS SUPPOSED TO BE THE ONLY EXIT$S MACRO ; IN THE ENTIRE OTS. THIS HELPS DEBUGGING BY ONLY ; NEEDING ONE BREAKPOINT TO INTERCEPT ALL EXITS. ; $EXIT$:: $AOTS MOV EXADDR(R3),R0 ;USER EXIT ROUTINE ADDRESS BEQ 1$ ;BRANCH IF NONE JSR PC,@R0 1$: EXIT$S .SBTTL TRAP INTERRUPT HANDLER ; ; TRAP INTERRUPT HANDLER ; THIS IS THE 'NORMAL' WAY TO SIGNAL AN ERROR. THE ; NUMBER FROM THE TRAP INSTRUCTION I ,LP:=DK1:[100,110]RSXM ,FPP,F4P,[300,120]ERRPT RE JMP $EXIT$ ;EXIT TO MONITOR ; ; TEXT FOR STOP AND PAUSE ; OTS$D ;PURE DATA SECTION TXTSTP: .ASCIZ /STOP / TXTPAU: .ASCIZ /PAUSE / .EVEN .END ETURN FOR ANOTHER $AOTS BR LSTLOP ;LOOP TILL IO LIST IS EXHAUSTED ; ; NUMERIC AND A FORMAT CONVERSIONS ; ; FIRST COME THE DEFAULT W.D CASES WHICH EVENTUALLY ; FALL INTO COMMON CODE FOR THE REGULAR CONVERSIONS. ; ADFMT: MOVB ITEMSZ+1(R3),LENGTH(R3) ;USE THE ACTUAL LENGTH CLRB LENGTH+1(R3) BR DFLTCM LDFMT: MOV #2,LENGTH(R3) ;LENGTH = 2 BR DFLTCM ODFMT: IDFMT: MOV #7,LENGTH(R3) CMPB #4,ITEMSZ(R3) ;*4 TYPE? BNE DFLTCM ;BRANCH IF NOT MOV #12.,LENGTH(R3) ;USE 12 FOR *4 CASS LOADED TO R0, ; LEGAL RANGES ARE CHECKED, ; THEN THE COMMON ERROR ROUTINE IS INVOKED. ; $SST6:: MOV R0,-(SP) ;SAVE R0 MOV 2(SP),R0 ;GET TRAP NUMBER DOUBLED ASR R0 ;BACK TO JUST ERROR NUMBER SUB #ERCLS0,R0 ;DOES IT BELONG TO US? BGE 1$ ;BRANCH IF YES MOV #ERSST6,R0 ;TREAT LIKE ILLEGAL TRAPS TST (SP)+ ;DISCARD SAVED R0 BR SST6 1$: JSR PC,$ERRAA ;DO ERROR ANALYSIS MOV (SP)+,R0 ;RESTORE R0 TST (SP)+ ;DISCARD TRAP NUMBER RTI ;EXIT INTERRUPT .SBTTL 11/40 FIS INTERRPUT .TITLE $ERRSET -SET ERROR CLASS CONTROL CODES IDENT 06 ;RFB 29-SEP-74 ; ; DISCLAIMER ; ; R. BRENDER 9-JUN-74 ; ;+ ; FUNCTION: ; FORTRAN CALLABLE SUBROUTINE TO SET ERROR CLASS ; CONTROL CODES FOR A GIVEN CLASS. ; ; CALLING SEQUENCE: ; CALL ERRSET(NUM,CONTIN,COUNT,ERREQ,LOG,LIMCNT) ; ; WHERE: ; NUM IS ERROR NUMBER, ; CONTINUE = .TRUE. => CONTINUE AFTER THIS ERROR ; COUNT = .TRUE. => INCLUDE THIS ERROR IN ERROR COUNT ; ERREQ = .TRUE. => TAKE ERR=EXIT ; = .FALSE. => RETURN TO REPR QD@ 2HJEp (Lp 优D4:;PS|;PI "m %Y$E#4UZ$R(ؘ KDY$E%SmkZh|SkH|K ÙdK؂ 8;PTd. EHh@@OXɡhH|K :M\_E,[ɔαL\ [z$OHA-J@ @ΘD D}. %YTɂD9L IME(p J@ J[:-}N%vh dB(ݪIeXHtK \E,v)h CY$E%Lvݡh GtHZdT5M.H|E PTIܞX$]P@ HrEJ-HCY$E"YLS\ [z$O EH!}J@ @Λ4U9,͏E BR DFLTCM FDFMT: EDFMT: GDFMT: DDFMT: MOV #15.,LENGTH(R3) MOV #7,D(R3) CMPB #8.,ITEMSZ+1(R3) ;*8 VALUE? BNE DFLTCM ;BRANCH IF NOT MOV #25.,LENGTH(R3) MOV #16.,D(R3) DFLTCM: MOVB R0,W.DFLT(R3) ;REMEBER DEFAULT TYPE SUB #CODEAD,R0 ;COMPUTE REGULAR TYPE MOV R0,TYPE(R3) ;SAVE THAT MOV R1,REPCNT(R3) ;SAVE REPEAT COUNT BR CONVEN ;START THE CONVERSION ; ; THE NORMAL FORMAT CODES COME HERE ; DFMT: GFMT: EFMT: FFMT: IFMT: OFMT: LFMT: AFMT: SUB #CODEA,R0 ;COMPUTE TYPE O HANDLER ; ; IF AN 11/40 WITH FIS THEN TRANSFORM THE FIS ; TRAP INTO AN APPROPRIATE ERROR REPORT. ; ELSE REPORT AS AN ILLOGICAL TRAP. ; $SST7:: .IF DF FIS BIT #1,4(SP) BEQ 1$ ERROR FZDIV ;FLOATING ZERO DIVIDE 1$: BIT #10,4(SP) BEQ 2$ ERROR FUNDFL ;FLOATING UNDERFLOW BR 3$ 2$: ERROR FOVRFL ;FLOATING OVERFLOW 3$: MOV (SP)+,2(SP) ;COPY UP TRAP PC & PSW MOV (SP)+,2(SP) ;OVERWRITING B ARGUMENT CLR 4(SP) ;DEFAULT VALUE IS 0.0 CLR 6(SP) RTI ;EXIT INTERRUPT .IFF ORTING ROUTINE ; LOG = .TRUE. => REPORT THIS ERROR ON LOGGIN DEVICE ; LIMCNT = INTEGER VALUE USED TO SET THE ERROR COUNT LIMIT ; ; NUM IS INTEGER FROM 1 TO ERMAXN ; REMAINING ARGUMENTS ARE LOGICAL (ANY ALLOCATION SIZE) ; TWO THRU SIX ARGUMENTS MAY BE SPECIFIED. ;- OTSWA ERRDEF OTS$I ;PURE CODE SECTION ERRSET:: $AOTS MOVB (R5)+,R0 BEQ ERR INC R5 MOV @(R5)+,R1 ;GET ERROR NUMBER BLE ERR ;BRANCH IF ERROR NUM TOO SMALL CMP R1,#ERMAXN-ERCLS0 BHI ERR ;BRANCH IF TOO BIRBdS|\_* mHHtȄP9tZR]ilЅ-.K|)bDHHtȄP9tR+#Rh@ETFZņ|\(,8A9͡hJI9$[d\([:- }Pi\Ѕ-.K|)bDPű#ZT;*EIZRJuO)vOh;,vh$@I)5@ OVE @O@O OLڂd]:ĒBEt.̤Vz,EKY,R0 ; JSR PC,$ERRAA ; $ERRAA:: JSR R5,.SAVR1 ;FCS REGISTER SAVE COROUTINE $AOTS ; ; SAVE ERROR NUMBER FOR $ERRZ ; NOTE THAT ERROR NUMBER GETS SHIFTED DOWNWARD ; SO THAT PRINTED NUMBERS START AT ERROR 1. ; MOV R0,R2 ;COPY NUMBER ADD W.ERTB(R3),R2 ;ERROR TABLE ADDRESS TSTB @R2 ;VALID ERRORS WILL HAVE AT LEAST ONE BIT ON BNE 1$ ;G ADD W.ERTB(R3),R1 ;ADDRESS OF CONTROL BYTE TSTB @R1 ;VALID ERROR NUMBER? BEQ ERR ;BRANCH IF NOT MOV #1,R2 ;ROTATING BIT DEC R0 ;COUNT ONE ARG USED BLE 1$ ;BRANCH IF NO MORE ARGS ; ; CONTINUATION ARG ; JSR PC,MORE1 ;IS THERE MORE? BCS 1$ ;BRANCH TO SKIP THIS ONE BICB R2,@R1 ;CLEAR CONTINUE BIT TSTB @R4 ;REQUEST IS FOR SET? BEQ 1$ ;BRANCH TOO LEAVE OFF BITB #EC.RTS!EC.ERE,@R1 ;CONTINUE ALLOWED? BEQ ERR ;BRANCH IF ILLEGAL REQUEST BISB R2,@R1 ;SET CONTINUE ON ; R;||Idvݡh2F:P;|XZ@ Hrɤ 4SɄit OI݊RK Pű#t YLvDhP@ O@E: LEHErEKXɡh E,-L bEȢLYL@DtP4vChDtSX%%HML\ YZ@ @tKe͐T,RZ@NPtH RSI85vԡh;tJ|[dαP9t:ܒLtPTd.J| -.LJ@ $( 2O܊ -A". %X$IKdČ2P9܊Ę44O9܊Ę4P,TK:-  BE儆. %)bDH@( L\Yb9ܤFtR]h$}(2CϗT NON-INFINITE FORMAT FLAG TST VARAD(R3) ;DO WE HAVE A DATA ITEM TO CONVERT? BNE 3$ ;BRANCH TO DO ANOTHER JMP RETURN ;JMP TO QUIT 3$: MOV TYPE(R3),R2 ;GET CONVERSION TYPE MOV BLBUF(R3),-(SP) ;SAVE STARTING RECORD ADDRESS MOV LENGTH(R3),-(SP);MOVE REQUESTED LENGTH OF ITEM MOV EOLBUF(R3),R1 ;GET END OF RECORD PTR SUB BLBUF(R3),R1 ;GET BYTES LEFT IN RECORD TST @FILPTR(R3) ;INPUT OR OUTPUT? BPL 1$ ;BRANCH IF INPUT ; ; DOING OUTPUT. CHECK THAT RECORD HAS ENOUGH ROOM ; TO HOLD THIS BRANCH IF VALID MOV #ERINVE-ERCLS0,R0 ;SUBSTITUE ERROR ERROR 1$: MOV R0,W.ERNM(R3) ;SAVE THE REPORTED NUMBER CLR W.FERR(R3) ;DEFAULT VALUES FOR FCS INFO CLR W.FER1(R3) ;RETURNED BY SNSERR CLR W.ERUN(R3) ; MOV FILPTR(R3),R2 ;IS THERE AN FDB ACTIVE? BEQ ACTION ;BRANCH IF NOT MOVB F.ERR+D.FDB(R2),R1 ;DID IT CAUSE THE ERROR? BPL ACTION ;BRANCH IF NOT CLRB F.ERR+D.FDB(R2) ;SO CAN'T REPORT THIS AGAIN MOV R1,W.FERR(R3) ;SAVE FOR SNSERR MOVB F.ERR+1+D.FDB(R2),R1 MOV R1,W.FER1(R3) ;ALSO; COUNT CONTROL BIT ; 1$: JSR PC,MORE BCS 2$ BICB R2,@R1 ;CLEAR IT TSTB @R4 ;REQUESTED ON? BEQ 2$ ;BRANCH IF NOT BISB R2,@R1 ;SET IT ON ; ; CONTINUATION TYPE ; 2$: JSR PC,MORE BCS 3$ ;BRANCH IF LEAVE AS IS TSTB @R4 ;REQUEST IS TAKE ERR=? BEQ 21$ ;BRANCH IF REQUEST IS RTS BITB #EC.ERE,@R1 ;ERR= ALLOWED? BEQ ERR ;BRANCH IF NOT BISB R2,@R1 ;ACCEPT THE REQUEST BR 3$ 21$: BITB #EC.RTS,@R1 ;RTS ALLOWED? BEQ ERR ;BRANCH IF NOT BICB R2,@R1 ;HONOR REQUEST ; ;Ri,%N H@ Hr BE儆. %YTՅvhJ|\_P)I]PTA,;P h@ )LdW$(Lp 优D4yE7,yME;,d܈,F؈ :, jOH|Hm-@0P@ IZDEXdαyuE1,,;P h@ )LJ-OE脊JeUXD, KXɡh m ,NWl8MH|dU$X)tPX0łT9EKY ۚEOZ) EZT;*OHutvšh mA-85T8uBRS\ Y YLvDhP@ O@Eh d,XN|zh™< L@9 "E)LHJ -zRYؒ FIELD ; CMP R1,@SP ;ENOUGH ROOM BGE 10$ ;BRANCH IF ALL OKAY ERROR RECBIG ;RECORD TOO BIG FOR BUFFER MOV R1,@SP ;SUBSTITUTE AVAILABLE ROOM BR 10$ ;AND HOPE FOR BEST ; ; DOING INPUT. DO SHORT FIELD TERMINATION ANALYSIS. ; 1$: CMP R1,@SP ;ENOUGH ROOM? BGE 2$ ;BRANCH IF SO MOV R1,@SP ;ADJUST W TO ACTUAL CHARS LEFT BNE 2$ ;BRANCH IF THERE ARE SOME INC @SP ;MUST HAVE AT LEAST 1 MOV #BLANK,2(SP) ;SUBSTITUE A BLANK BR 13$ ;AND KEEP GOING 2$: BIT #DV.FRE,@FILPTR(R3) ;SHORT  F.ERR+1 MOVB F.LUN+D.FDB(R2),R1 MOV R1,W.ERUN(R3) ;AND UNIT NUMBER ; ;NOW GET ERROR CONTROL BYTE, ;NOTE FACT OF THIS ERROR, ;AND DECIDE IF WE CONTINUE OR EXIT ; ACTION: MOV R0,R2 ;ERROR NUMBER ADD W.ERTB(R3),R2 ;ADDRESS OF ERROR TABLE BISB #200,@R2 ;NOTE THIS ERROR MOVB @R2,R1 ;GET BYTE ASR R1 ;CONTINUE BIT ON? BCC EXIT ;BRANCH IF NOT ASR R1 ;DO WE COUNT? BCC 1$ ;BRANCH IF NOT DEC W.ECNT(R3) ;DECREMENT COUNT BEQ EXIT ;EXIT IF GOES TO ZERO 1$: TSTB W.IOEF(R3) ;INTERNAL  LOG CONTROL BIT ; 3$: JSR PC,MORE BCS 7$ BICB R2,@R1 ;INITIAL CLEAR TSTB @R4 ;ON? BEQ 4$ ;LEAVE AS IS BISB R2,@R1 ;SET TO LOG 4$: .IF DF FPP TSTB W.FPPF(R3) ;IS THERE AN FPP ON SYSTEM? BNE 7$ ;BRANCH IF NOT SUB W.ERTB(R3),R1 ;RECOVER ERROR NUMBER CMP R1,#FUNDFL-ERCLS0 ;FLOATING UNDERFLOW? BNE 7$ ;GO ON IF NOT TSTB @R4 ;REQUEST ON? BEQ 5$ ;BRANCH IF OFF STFPS -(SP) ;FPP STATUS BIS #2000,@SP ;SET INTERRUPT ON UNDERFLOW 6$: LDFPS (SP)+ ;REPLACE STATUS BRR2W9LO *S YD 2O ) EP@ IEyIDEL@JR jN[TYT|H@OD D}.d) EtMJE ]P@T,EIMORIh@ *E) J-OT m\,Y:dPP@yuID@E:e`h@ HrELyMIDEZRJuOYT|vh2C( $.ZRJuOh@T,H*EI:t,TcYLvDh m[h|SkߙSE.DUtPE넨ͺ9O ;PIZeBE넆ZűK OLڒȉdYuvhd\ۉ|,AHup GthR@ TtS(}׉ʎIDzh™< )L:V E焘d\ۘDzEFIELD SCAN? BNE 10$ ;BRANCH IF NOT WANTED TST R2 ;IS IT A FORMAT? BEQ 10$ ;BRANCH IF IT IS MOV @SP,R1 ;GET FIELD SIZE 11$: CMPB #',,@BLBUF(R3) ;IS CURRENT BYTE A COMMA BEQ 12$ ;BRANCH IF YES TO SHORTEN FIELD INC BLBUF(R3) ;ADJUST RECORD POINTER DEC R1 ;MAKE SURE WE STAY IN FIELD BNE 11$ ;BRANCH IF MORE CHARS BR 13$ ;PERSON DIDN'T USE COMMA FEATURE BUT ;NOTE THAT BLBUF IS ALREADY ADJUSTED 12$: INC BLBUF(R3) ;POINT PAST COMMA SUB R1,@SP ;ADJUST FIELD WIDTH COUNT BNE 13$OTS ERROR HANDLING? BLE 5$ ;BRANCH IF NOT FOR NORMAL PROCESSING ROR R1 ;SKIP ERR= BIT BR 2$ ;GOTO LOG BIT PROCESSING 5$: ROR R1 ;ERR= NEEDED? BCC 2$ ;BRANCH IF NOT MOV ERREX(R3),R4 ;ERR=PRESENT (LEAVE C) BEQ EXIT ; ;THIS TASK WILL CONTINUE ; 2$: ROR R1 ;LOG IT? (REMEMBER PREV C) BCC 3$ ;BRANCH IF NOT CLR R0 ;NO EXIT FLAG JSR PC,$ERRZ TSTB W.IOEF(R3) ;SPECIAL INTERNAL HANDLING? BNE 4$ ;BRANCH TO TAKE RTS RETURN 3$: ROL R1 ;RECOVER RTS/ERR=BIT BCC 4$ JMP $IOEXIT ; 7$ ;CONTINUE 5$: STFPS -(SP) BIC #2000,@SP ;DISABLE INTERRUPT ON UNDERFLOW LDFPS (SP)+ ;REPLACE .ENDC ;DF FPP ; ; ERROR COUNT LIMIT ; 7$: JSR PC,MORE ;IS THERE A LIMIT COUNT? BCS 8$ ;EXIT IF NOT MOV @R4,W.ECNT(R3) ;USE IT 8$: RTS PC ; ; INTERNAL ENTRY MORE ; ; FUNCTION: ; DECREMENT ARG COUNT, EXIT IF ALL DONE. ; SET C-BIT IF A NULL ARGUMENT ; SHIFT BIT USED TO TEST ERROR CONTROL BYTE ; MORE: ASL R2 ;ROTATE BIT MORE1: DEC R0 ;ARG COUNT BMI 1$ ;BRANCH IF DONR HE @RZTHͱsYy܊5bؤ H}BEP@t 9AQd YD H-ψ*L9ĕBCdԈ-BIDXHLOB:|A[dyLNHe: IHLP@ YSx:}\(YbID ӱK4LZ\Y:ܤ,U-PH}BEPEX\Dȑz,;P h@ )LUR9 zh™< L bIDyL;PIEvh$@I)5@锨z J@ $B< HI "E @RڤAd) EtTm;|P@BM: (ݤ-F@)uZIME\ ڤA8k$.yL H@ IE(p LM: ܆S|F Lt ;BRANCH IF FIELD NOT NULL MOV #BLANK,2(SP) ;POINT AT A BLANK INC @SP ;PERSON USED ,, - MAKE IT LOOK LIKE ' ' BR 13$ ;SKIP ADJUSTMENT 10$: ADD @SP,BLBUF(R3) ;SWALLOW CHARS FROM RECORD 13$: CMP #FMTI,R2 ;CHECK TO SEE IF D PRESENT? BGE CV ;BRANCH IF NO D MOV D(R3),-(SP) ;PUT D ON STACK FOR CONVERSION ROUTINE MOV PSCALE(R3),-(SP);PUT SCALE FACTOR ON STACK ALSO .IF DF F4 CV: MOV ITEMSZ(R3),R1 ;GET VARIABLES SIZE TST R2 ;DONT CHECK FOR A FORMAT BEQ VALID ;A FORMAT IS ALWAYS OK TAKE ERR= TRANSFER (R4 = ADDRESS) 4$: RTS PC ;TAKE RTS ; ;THIS TASK WILL EXIT ; EXIT: MOV #-1,R0 ;TELL $ERRZ WE ARE EXITING JSR PC,$ERRZ ;LOG ALWAYS ; ; EXTERNAL ENTRY USED BY OPEN/CLOSE ; STATEMENT PROCESSORS TO CAUSE TASK EXIT. ; $ERXIT:: $AOTS MOVB #1,W.IOEF(R3) DIR$ #SVTK ;INHIBIT ERROR LOOP JMP $EXIT ;CLOSE FILES AND EXIT TO MONITOR ; ; INTERNAL ENTRY $ERRZ ; $ERRZ: JSR R5,.SAVR1 ;SAVE REGS $AOTS JSR PC,$ERRZA ;INITIAL TEXT TST R0 ;EXITING? BEQ 1$ ;BRANCH E MOV (R5)+,R4 ;GET ARG ADDRESS CMP #-1,R4 ;NULL ARG? BEQ 2$ ;BRANCH IF YES CLC ;USE THIS ARG RTS PC 1$: TST (SP)+ ;DISCARD LOCAL PC 2$: SEC ;SIGNAL NULL ARG RTS PC ERR: ERROR ERINVA ;INVALID ARG RTS PC .END R YLvDhGtL\ D@:e`h@ Hr J@ ,@I\Dȑz,;P h@ )LX,L(mPELl h@ڤ;P:V dO؄ L id "cت [ m(8vݡh@DOܞR]h@ H rE) J@ ,@ʼn̊ӸeLR@IuZRJu $N;|dDt.[dڤ[dN1|,;P h@RILPE 5E:eR2EPB JGZtAB h䊐T4MRILE@YXZ@SXtYP@UL|II pB h䒂P*-PJrPd,IB ZO(HxE, J@ @ƈt}B CMPB R1,#3 ;SEE IF A 1 WORDER OR 4 WORDER BLT ONEWDR ;BRANCH IF IT MUST BE I,O,L FORMAT CMP R2,#7 ;OTHERWISE IT MUST BE D,E,F,G FORMAT BGT VALID ;BRANCH IF IT IS FERR: ERROR FCERR ;FORMAT TYPE INCCORRECT NXTITM: JSR PC,@(SP)+ ;CALL COROUTINE TO GET NEXT VARIABLE $AOTS ;R3 PROBABLY GOOD?, BUT NOT SURE DEC REPCNT(R3) ;ANY MORE OF THIS TYPE? BMI FINTRP ;BRANCH IF NOT TO INTERPRETER MOV TYPE(R3),R2 ;RESET TYPE BR CONVLP ;MORE CONVERSIONS ONEWDR: CMP R2,#7 ;ONLY VALID TYPES ARIF NOT MOV #TXT7,R1 ;"EXITING DUE TO" JSR PC,$FILL 1$: MOV #TXT2,R1 ;"ERROR" JSR PC,$FILL MOV W.ERNM(R3),R1 ;ERROR NUMBER JSR PC,$BINAS ;TO ASCII JSR PC,$ERRW1 ;OUTPUT LINE .IF DF RSXM ; ; HANDLE INCORE ERROR TEXT ; MOV #$ERTXT,R1 NEXT: MOVB (R1)+,R2 ;MESSAGE NUMBER BEQ PCLIN ;BRANCH IF NO MORE TEXT BIC #177400,R2 ;MASK SIGN EXTEND CMPB R2,W.ERNM(R3) BEQ MATCH SCAN: TSTB (R1)+ ;SKIP BYTES UNTIL BNE SCAN ;A 0 IS FOUND BR NEXT ;TRY AGAIN FOR A MATCH MATCH: JSR PChB -TJ@ Xɡh@ tE͎dRT@ SFE-IO,Z@D̡h@ΚdLT(H YLS\ tE ČHdMT,LɤԅPH@ ,@ŚdL(E|vh@ J@  ZYDTG`@ Id[d[JMAIME(p  I-OK-yDIH@ 8H|,EKJ@ dL.H|TlE bMAeHH rh|SEzH*ELH@  b9L;P@S--ӘDyuIDvEh ) ECDZRR J@ [d\_Ȝv؉|\yICH@ 8j4D:-IXűKH@ 8H|,EKH@ YvDh@E  ,@dLAOȔؚdVR @| YD Dy,!-@(dX@,4 :uATIxQ,@(H@@ tIdz8|ԡhJ TDS9 y,%- J@ @ƈDZmdYO d XΡhJ YD * H @Zm@ OH `B H@ )5@͈dÙ@L bX@d|APR<B H@. ETD@A 9 2E:MEјB H@ T "@X "RZ4ETII@E4SEPNL*B H@Y HD @ƈ̘OH(B H@ ,RIAt}T(Tl@AXZ.P y,ΚPE:MEJE(e R3l HrOJUjR3@DJEHͫE I,O,L BGT FERR ;BRANCH IF NOT I,O,L VALID: TST @FILPTR(R3) ;IS IT READ OR WRITE? BPL INVAL ;BRANCH IF ITS INPUT MOV VARAD(R3),R3 ;GET ADDR OF VARIABLE, NOTE R3 IS WIPED TST R2 ;SEE IF A FORMAT? BEQ AOUTPT ;BRANCH IF IT IS, WE HANDLE IT CMPB #1,R1 ;ARE WE WORKING WITH A BYTE? BEQ 3$ ;BRANCH IF IT IS CMPB #4,R1 ;IS IT SINGLE PRECISION BNE 6$ ;BRANCH IF NOT CLR -(SP) ;MAKE IT LOOK LIKE DOUBLE CLR -(SP) 6$: BIC #177400,R1 ;CLEAR OUT DATA SIZE TYPE SUB R1,SP ;ALLOCATE STAC,$ERRNL JSR PC,$FILL ;USE THIS TEXT JSR PC,$ERRW1 ;OUTPUT IT .ENDC ;DF RSXM ; ; GIVE USER PC IF AVAILABLE ; (ONLY SET UP FOR SST AND FPP TYPE ERRORS) ; PCLIN: MOV W.PC(R3),R4 ;IS THERE A VALUE? BEQ CNTLIN ;BRANCH IF NOT JSR PC,$ERRNL MOV #TXT9,R1 ;"AT PC = " JSR PC,$FILL MOV R4,R1 ;THE PC VALUE JSR PC,OCTASC CLR W.PC(R3) ; ;TELL IF ERROR COUNT IS CAUSE OF TERMINATION ; CNTLIN: TST W.ECNT(R3) BNE FCSLIN JSR PC,$ERRNL MOV #TXT8,R1 JSR PC,$FILL ; ; FOR I/O EeČ1P@ Hp L\ tE -HD|T,HId[d[JMA SH@ IE9Xt‘H*SFE-ZI-OK-yDIH@ YS(p 8M|LPYOЉ-ԱKHPEdH|\ }*OȌ eROȔ eRHFE-GH͕BvhZNZ$Y*EEPI-ψ*Xvh,;P@ @!TI}Eh@EL H-ȄؕBtVCYmC mEKMvh@ PEdH|\ }*OȌ eROȔ eRh|SYPЕJP@ 8H|UT mv)h@ lPEYhKI$@G: tΧ=HTW^]T|E!KЧx=9Ί-x>Z$ MOhKE)'}t:AK-N 2$: MOVB (SP)+,@R0 ;MOVE BYTE TO VARIABLE BR NXTITM ;GO SEE IF MORE LOGICAL CONVERSIONS .ENDC ;DF F4 .IF DF F4P MOV W.VTYP(R3),R4 ASL R4 ;MAKE VARIABLE TYPE DISPATCHABLE MOV TYPE(R3),R2 CMP #FMTL,R2 ;LOGICAL CONVERSION? BNE 2$ ;BRANCH IF NOT TST @SP ;MAKE A FOUR BYTE VALUE FOR LATER SXT -(SP) 2$: CMP #FMTI,R2 BLO FLOAT VTDSP1: JMP @VTYP-2(R4) ;DISPATCH ON VARIABLE TYPE OTS$D ;PURE DATA SECTION VTYP: VTL1 VTL2 VTL4 VTI2 VTI4 OTS$I ;PURE CODE SECT;QUOTIENT IN R2 1$: ADD #'0+10.,R1 ;MAKE REMAINDER INTO CHAR MOV R1,-(SP) ;SAVE FOR NOW MOV R2,R1 ;SET UP FOR NEXT CHAR BEQ 3$ ;ZERO MEANS NO MORE TO DO JSR PC,BINAS2 ;RECURSE 3$: MOVB (SP)+,(R5)+ ;OUTPUT CHARS AS RECURSION RTS PC ;UNWINDS ; ; EXTERNAL ENTRY $FILL ; $FILL:: CMP R5,W.ERLE(R3) ;TO END OF AREA YET? BHI 1$ ;EXIT IF SO MOVB (R1)+,(R5)+ ;COPY TEXT BNE $FILL ;LOOP IF MORE DEC R5 ;BACK UP ON ZERO TERMINATION BYTE 1$: RTS PC ; ; INTERNAL ENTRY $R50AS ; $R50AS89'}Hؠ XE IEv)hX\_XSؠ XE BEdRf|R]ؒ 2SX -@0 \ j@ј@ T,S9DXE8\,[d1bEk,`KZCU$LH*OXEt }2+3`bTK(dʊLŤ2KZպEKbؘ -dDZC mEKMP}̸ŚKPt }1+3RZd[d[|Th:]O9,[dIL1-K5\[d18|ؘ LU$F:CU$.-+vh̸tψ*IH*LŤՍP h@RI9ڬ(ڬTUN-NH z)h™< L@[dE *JG$L@JEE؞ 伊LY@űy} G)L8RA*9|'} JxttӠx/Z$tOB HDt>VPӘz:ߔP)L:Mt>ӊBc,x,DttLG JxYt>ӜUHu哪't< W Jxt>Z/hPl rH)$-SlT4A*E)"@4L7 hR@ TtBPE[d,9-Z(Lp  LY@[d,<@Zͷ)L:V O+Eؘ 8|@y)X֔*M,9,h-Xؘؔ 8|@Ic4Iئ i YdGCLztH֔HI"N[$u*PZ͵vhj̊֡h@ HION ; LOGICAL*1 VARIABLE VTL1: JMP @VTL1T-2(R2) ;DISPATCH ON CONVERSION CODE OTS$D ;PURE DATA SECTION VTL1T: VTL1L VTL1O VTL1I OTS$I ;PURE CODE SECTION ; L*1 VARIABLE, OCTAL CONVERSION VTL1O: MOVB @SP,@R0 ;VALUE TO VARIABLE CLR R4 ; VERIFY VALUE RANGE VTL1CM: MOVB R4,@SP CMP (SP)+,R4 ;SHOULD BE SAME BNE INVER1 CMP (SP)+,R4 BEQ NXTITM BR INVER0 ; ; REPORT CONVERSION ERRORS ; INVER1: TST (SP)+ INVER0: ERROR ICERR BR NXTITM ; L*1 VARIABLE, INTEGER CONVERS: MOVB #' ,(R5)+ $R50AB: MOV R1,-(SP) ;SAVE COUNT JSR PC,$R50 MOV (SP)+,R1 ;RECOVER COUNT TO LIMIT BACKUP 1$: CMPB #' ,-(R5) ;DELETE TRAILING BLANKS BNE 3$ ;BRANCH IF DONE SOB R1,1$ ;LOOP IF NOT TOO FAR 3$: INC R5 ;RESTORE LAST NON-BLANK RTS PC ; ; INTERNAL ENTRY OCTASC ; OCTAL TO ASCII CONVERSION ; OCTASC: MOVB #30,@R5 SEC 1$: ROL R1 ROLB (R5)+ MOVB #206,@R5 2$: ASL R1 BEQ 3$ ROLB @R5 BCS 2$ BR 1$ 3$: RTS PC OTS$D ;PURE DATA SECTION ; ; TEXT USED IN THE DNEdTlLĘ·-h),|2LĨ@]ZtJMYh@tEK݊5E bE;P Kvh mR-J mR *OLŨO5LE܌;PLŎE5vh(̙ΔP@ IE(p dL.TDP,IUJUh@T,B< H@tA#X H@ HrELHPEt[YT8dEd`,cGȤ…bvh8MH|\Kt,X]cX0tRT H LTZCU$.%RKeYUXƂ`,KHΡh@ETJPEt[YF9dUƂ`,cP̸tω*A9bLHΡh@*ELL\ tġh@Xɡh 2N-ѥH,NR rElXEt.9-]ETH@ ETR؜JݤAۥH|&ו)M:ĒBEt.H|&X](u9 vh*BMKX$U.kPI)uɘP h@RI(ODXZ͵PJSHut+J$x.+t;VܨB h™< )L:V O+EdR#S(}z[d;P( ZElvˡh l)LΆvhMCPDtIܨJ,H{t\Z͵PI(%EeNٔűK)uɘP h@RI()PtXEZ͵PELl h@tvEh l)LΆv)hMCPDtbRR؜ӱK)ZՉOlR، L;PRH GthR@ TtB,PEtXEION VTL1I: MOVB @SP,@R0 ;VALUE TO VARIABLE SXT R4 BR VTL1CM ; L*1 VARIABLE, LOGICAL CONVERSION VTL1L: MOV @SP,R4 MOVB R4,@R0 BR VTL1CM ; ; INTEGER*2 OR LOGICAL*2 VARIABLE ; VTI2: VTL2: JMP @VTL2T-2(R2) ;SECONDARY DISPATCH ON CONVERSION TYPE OTS$D ;PURE CODE SECTION VTL2T: VTL2L VTL2O VTL2I OTS$I ;PURE CODE SECTION ; *2 VARIABLE, LOGICAL CONVERSION VTL2L: MOV @SP,R4 BR VTL2CM ; *2 VARIABLE, OCTAL CONVERSION VTL2O: CLR R4 BR VTL2CM ; *2 VARIABLE, INTEGEERROR REPORTS ; TXT1: .ASCIZ / -- / TXT2: .ASCIZ /ERROR/ TXT3: .ASCIZ /FCS/ .IF NDF RSXDV6 TXT4: .ASCIZ / IN "/ TXT5: .ASCIZ / FROM "/ TXT6: .ASCIZ /" AT/ .ENDC ;NDF RSXDV6 TXT7: .ASCIZ /EXITING DUE TO / TXT8: .ASCIZ /(ERROR COUNT EXCEEDED)/ TXT9: .ASCIZ /AT PC = / .IF DF F4P TXT10: .ASCIZ / OR AFTER/ .ENDC ;DF F4P .EVEN .IF DF RSXD FILDES: +FILLEN,FILSTR .IF DF F4P FILSTR: .ASCII /[1,2]F4POTS/ .ENDC .IF DF F4 FILSTR: .ASCII /[1,2]FOROTS/ -ۥvh KJK$J5AѥH@ H rPEdH|YUXƂ`,H H@ YS8H|: CU$IUJUhH@ IE9UDETCڬXFhHN- HdLYP単.N-8}X]D`KHű#LPEdL.DEb YD : CQ$H8ey,ΑPKMPtRT HܨThH` JLH\ U YLvDhP@ O@E$=PELy} h@Md7|RH؄ L h@tzE[d;PE:ME(8PΘE L\ HbZ@̚dSH J@ @dL.Eܬ HHrELJ@ (dʞN[$)dƗH@ PEdH|\RZ͵PJSHutL*bL B[x +t;VDVlZ+(Lp  SXH|PO RJ4,T)L8DNب m\Kt%Gj45)M:ĒBEt.H|&X(u9 vhMYT[-0P@ IEEZP)uRHܤ8\ڤR1Kр GthR@ TtB٬PtXEZ͵PELl h@tvEh l)LΆvhMCPDtbRR؜ӱKD:-DYlvh'tJMhű#P  Z}I*R,PEtXEZ͵PJSHutغM:Lh xTtNWl IMx +t;gݺThPELl h@tvEh*ӈEL\(tE }1jeEZRR CONVERSION VTL2I: TST @SP SXT R4 ; VERIFY VALUE RANGE VTL2CM: MOV (SP)+,@R0 CMP (SP)+,R4 BNE INVER0 BR NXTITM ; ; INTEGER*4 OR LOGICAL*4 VARIABLE ; VTI4: VTL4: MOV (SP)+,(R0)+ MOV (SP)+,@R0 BR NXTITM ; ; HANDLE FLOATING CONVERSION CODES HERE ; FLOAT: CMP #2*A.INT4,R4 ;MUST BE FLOATING DATA TYPE BLO 1$ ;BRANCH IF OKAY CMP (SP)+,(SP)+ ;DISCARD TWO TEMPS BR VTDSP1 ;TREAT AS INTEGER 1$: CMP #2*A.REA8,R4 ;TWO OR FOUR WORD VARIABLE? BEQ 3$ ;BRANCH IF FOUR ;ROUND .ENDC FILLEN =.-FILSTR .ENDC .EVEN ; ; DPB TO DISABLE ALL SYNCHRONOUS TRAPS ; (EXCEPT OTS ERROR TRAPS) ; SVTK: SVTK$ ERSVTK,7 ERSVTK: +0,0,0,0,0,0,$SST6 ; ; PROTOTYPE ERROR CONTROL TABLES ; THESE MUST BE COPIED INTO THE IMPURE ; WORK AREA BY OTS INITIALIZATION. ; .MACRO DE NAME,NUM,VALUE,TEXT .=$ERRTB+NUM-ERCLS0 .BYTE VALUE ;TEXT NAME =NUM .ENDM $ERRTB:: ERRDEF INIT .=$ERRTB+ERMAXN-ERCLS0 .EVEN $ERRTE:: .END tE }1+3vh@Ltω*A9bO-2KJ@ , H*ELJ@ (dʞN[$9fƗH@ PEdH|\tE }1+3vh@Ltω*A9bO-3KJ@ , J@ ,@XɡhL )bDbX }N EٓEdR4#L7Ê̱8MH|,EK8MH|UT mv)hH-Ȅؕ.-Ћ-\[d294[d]PZEC mEHh|SEYZ,P v)hH[ȊXr,r]P(Lp  SX-)L:V O+E8eDC'°E,--L bTʂMdO9eDvLhƚt;PPE8tP(ܞC[$IXƂ`,K8E؜ e;PDL5,2LŘB9|ݑPYD(e@t9d}@]Zt\[dMH RSI85ԑP@t5e.-:S5H8e`H YLSP@t -@0ΔP@ 8H|\JRh-Cd)-IME,\t`KL@JR jItZ zLňO9-5蔌O85Zѐ@ DL\([d\[ FOUR WORDS TO TWO MOV SP,R1 ;MOVABLE STACK POINTER CMP (R1)+,(R1)+ ;SO MOVE IT TO LOW ORDER WORDS ROL @R1 ;GET ITS HIGHEST BIT MOV (SP)+,(R1)+ ;COPY UP HIGH ORDER WORDS MOV (SP)+,@R1 ADC @R1 ;USE SAVED BIT TO ROUND ADC @SP BVS 2$ ;BRANCH IF OVERFLOW BCC 4$ ;BRANCH IF NO OVERFLOW 2$: ERROR ICERR ;INPUT CONVERSION ERROR BR 4$ 3$: MOV (SP)+,(R0)+ ;RETURN VALUE TO VARIABLE MOV (SP)+,(R0)+ 4$: MOV (SP)+,(R0)+ MOV (SP)+,(R0)+ BR NXTITM .ENDC ;DF F4P ;A FORMAT OUTPUT C*FTDD@Yuѐ! ŦI(b1O)IO(LO)IR@ I,6l,@P%|RR@Z< $|N(l@(@ EdŊ@%u``K@R$uM"`@ Ed5E\ V&v)h@ +@ -A,XSF+P RID-D@9% i-9DM'R@ Hϱ+@OXF@I@ԹP}P9CtSJ R JH rE)`  RIL L LWlX0_d;R@ -N[l)@I=N@ @t \(|8DD,LUl@ΕPRXdP9Ct@ZUrv)hBLS8E,@ (} Y}@Td|T(!4@E4M@AXthMجE婔;|9DXEcX0H mO(ݪIe8H|: CU$Ci,AcX0ZB H,ŒdbX.,-rhPELl h@tvEh lSX، 褊ئ i αdL.H|H|X@]J=b h@ H r )Dj4[TO-O9-5蔌O85Zш $D*ӈEL\(tEtL{\|ԵvhW-BYTES IN ITEM TO RECORD ADDR SUB R1,R3 ;TO POINT TO RIGHTMOST CHARS MOV R1,R2 ;MOVE ITEMS NUMBER OF BYTES AMOVE: MOVB (R3)+,(R0)+ ;MOVE A BYTE DEC R2 BNE AMOVE BR NXTITM ;GO BACK FOR MORE ;A FORMAT INPUT CONVERTER AINPUT: TST (SP)+ ;POP JSR'S RETURN, WE DONT NEED IT MOVB ITEMSZ+1(R3),R1 ;GET BYTES IN VARIABLE MOV (SP)+,R2 ;PUT WIDTH IN R2 MOV VARAD(R3),R0 ;ADDR OF VARIABLE INTO R0 MOV (SP)+,R3 ;RECORD ADDR INTO R3 CMP R2,R1 ;COMPARE WIDTH AGAINST SIZE OF ITEM BGE AINP b|"9A'%p1E 8L(}=Gh H9 :M !9WA9PєB9LbZ.jZjZj@BBHZYdGBBh4Zш!R(-ŦI&@4 db dFL @ E9vRTJRD NHT%R@ 9A+%d@ t UYdZ_@Y%*$-Lzt@H(@ XFSCk`c;*UmBh4@( RI, TDFTdI@A*!-BL DFL@TDzr h 8@ڤCUZ4 @DMS8ĚI(ꔨTDAX@YdG B@ƈ@ i̙  @ @t \P ڤCRD JH rE)` @ PTIPԗJ Lh@DD @Ɖt̹b@ZtJMYh@Ήt̹`cR]#PRd4HJdd( XJE:J(dWtLPEdH|\[d[&R]ئ H-ω*A99d%}.-+`bEbRLCF|O蔌O85V @O }Nh|SJ@ $B< HRY$A \[d\[JEսP̸tω*A9bEژ-R dL.@1ZtJMQJ@ @ZCU$LH*\,[d\[JEսX0DDھZhH[ʊ,ʒX'5+NT:XDmZtZX)ѥB JGZtAB h䊐T4MRI)H(}4-UD,I :t-:, J@[PTERPRETER CODES DISPTB: .WORD FMTBAD,FMTBIG ;THE ERROR CASES FROM FMTCV .WORD TPLVL,LPAREN,RPAREN,EOFMT,SLASH,DOLLAR,COLON .WORD PFMT,QFMT,TFMT,XFMT,HFMT CODEA =.-DISPTB FMTI =6 FMTO =4 FMTL =2 FMTA =0 .WORD AFMT,LFMT,OFMT,IFMT,FFMT,EFMT,GFMT,DFMT CODEAD =.-DISPTB .WORD ADFMT,LDFMT,ODFMT,IDFMT,FDFMT,EDFMT,GDFMT,DDFMT CODEMX =.-DISPTB-2 ;MAXIMUM DISPATCH CODE ; A BLANK USED IN PLACE OF NULL WIDTH FIELDS BLANK: .BYTE ' .EVEN .END hRI ʪOEi@ӤhZjZjZjZjZjZjZjZjZh hBZ}I1-BjZjZjh@G(|@TtO PԊK@@!Z}PYE@KjD@D$}C% ru ZDER@  @ Z$b= KTZ$ B @ @2Bt@YZ$I(tDѰ@ @@ D@ Li-×HLHR@ @ @Li-@DKt*-DѰ@ h™< L@"v1hE8L\(Z$I*e-Dt.S@Dt\ :eF:T,T̨BȵtP\_Z$I*@KıdL.Z@ H rE);P@DtE bSZ$ YD 2T@Ԉ@ZUs# ČBHt@ֈ@)ttdEZhH[ȊXVl]P(Lp  LY@[d,<@Zͷ)L:V O+Eؘ 8|@y)vɡhštd(K:ĒBEt.H|&ՕAyͤEZ(9-ZPEZP:ĒBEt.H|&OՕAyͤEZ(9-ZvhM;PJtEʬ()}͗jiL\ ٔYLvDhP@ O@EyIY-TId-R؜KB ;· D KDyI*Lx+ zdEtV܊ŒbKeJXɡh E,-R9m9-[@DJEvءh l)LΆv)h*ӈEL\(tE }1dYZDBElR˗JML\(tE蔺1c. %RZR]، MUv)h+*Y5Eb YD 2N[$X@]- dTP@ Hr+)dDEZ}(JMYbO-ZFKdL. %R2@]- JMYh@ HrEL8LP]dL.CJ[R+#(}F@р HHr*c8LP蔺1+)dD8LP蔺2H؊ GthR@ TtGDzTh™< L\ JT9ܤFt@Zt`IEh™< HLÔF|ALڠ+ }NՍWHR]kT zEL8MH|\JTb+ =cX08tPEʬOHI ӗBH؈ ,ZREuv)hű#,;P h@ Z\ShPf rH r@ H( b@ZX.P y,ΙPO XNu@;tPyMI*NtR@tOP@ \ 6nhYD ĞL}YLS\ J@ @Ή-| H@ YSZ\(8JTJyMI*@NZd\Z@$(JU$BR" \_rvhhű#P  dA)LIUDXXZR y,ΙPEXNXDTtXYuP@ (p@ L @ I Č@0ΑPZ@N 4."POZ}PD0KTEuR@ R* \ rv)z;P@ K[J@ ĚUBJ@ Z}PVRv)h@ؒ 2BTL J@ @Xɡh9DXEH% X0łLŤ2KdKH|: CU$.-dƗ8MH|: CU$C|\,[d[&ՕX0ZO85PZh@I@8D@1a|HѠ HA"P$R( HXPZ$PֱKHԑHHrA)̘ϗBh@@!x|I}Eh@DuObP  7-HNH|R ,;P  Z}I*A#dL.)Eܬ Č0P@ IE(p ZNZ$Y*EPFE-ZP٤xDu,PP @ ET.)Eܬ Čb-  Z}I*O 2OȔؚdVeEb 8 kbwc;Plۅ$Z߱lS\αlD[tvhIņO IŜ