; ; I/O PROCESSOR GENERAL STACK TABLE (ADDRESSED BY R4) ; SAVER5 = 0. ;SAVE AREA FOR REGISTERS 0-5 SAVER4 = SAVER5+2. SAVER3 = SAVER4+2. SAVER2 = SAVER3+2. SAVER1 = SAVER2+2. SAVER0 = SAVER1+2. ERRFLG = SAVER0+2 ;=0 IF NO ERRORS ;=1 IF FLUSHING I/O LIST ENDERR = ERRFLG+2. ;PTR TO END AND ERR ADDRS ARGLEN = ENDERR+2. ;LENGTH OF CURRENT I/O ITEM 0,1,2,4,8 ARGTYP = ARGLEN+2. ;TYPE ITEM 1=B,2=I2,4=I4,5=R,6=C,8=D ARGPTR = ARGTYP+2. ;ADDRESS OF CURRENT I/O IT; ; I/O PROCESSOR FORMATTED I/O STACK TABLE (ADDRESSED BY R5) ; TSPECO = 0. ;RECORD MAX POSITN PTR(OUTPUT) PSCALE = TSPECO+2. ;CURRENT P SCALING FACTOR DSCALE = PSCALE+2. ;CURRENT DECIMAL WIDTH FWIDTH = DSCALE+2. ;CURRENT FIELD WIDTH REPCNT = FWIDTH+2. ;CURRENT SPEC REPITITION COUNT SCNKAR = REPCNT+2. ;CURRENT CHAR PTD TO BY FMTPTR CVTRTN = SCNKAR+2. ;CURRENT SPEC'S CONVERT ROUTINE ADDR CVTSW ; ; I/O PROCESSOR UNFORMATTED I/O STACK TABLE (ADDRESSED BY R5) ; IOSTAT=0. ;3=ONLY SEGMENT, 1=FIRST SEGMENT, 2= ;LAST SEGMENT, 0=NEITHER FIRST NOR LAST ; ; IOUSTK=IOSTAT+2. ;LENGTH OF UNFORMATTED STACK TABLE ; ; ; ; I/O PROCESSOR RANDOM I/O STACK TABLE (ADDRESSED BY R5) ; RECMAX=0.   ;TOTAL NUMBER OF FIXED LENGTH RECORDS LENMAX=RECMAX+2.  ;REMAINING NUM BYTES TO USE (THIS REC) AVADDR=LENMAX+2.  ;ADDR OF ASSOCIATED VAR ; IORSTK=AVADDR+2.  ;LENGTH OF RANDOM I/O STACK TABLE ; ; EM RECEND = ARGPTR+2. ;ADDRESS OF END LOC+1 IN CURRENT I/O BUFF RECPTR = RECEND+2. ;ADDRESS OF CURRENT POSITION IN I/O BUFF RECADR = RECPTR+2. ;ADDRESS OF START LOC OF CURRENT I/O BUFF IOTADR = RECADR+2. ;$INFR,$OUTFW,$INR,$OUTW,$INRR,$OUTR IOTSW = IOTADR+2. ;TYPE OF I/O-0=FMTD,1=UNFMTD,-1=RANDOM IOADDR = IOTSW+2. ;$FIO,$UIO,$RIO IOSW = IOADDR+2. ;INPUT/OUTPUT SWITCH - 0=OUTPUT,1=INPUT FMTADR = IOSW+2. ;ADDRESS OF START OF FORMAT STMT RNUMAD = FMTADR ;ADDRESS OF REC = CVTRTN+2. ;CURRENT SPEC D=0,EFG=-1,IO=1,A=2,L=3 INT = CVTSW+2. ;NUMERIC ACCUMULATOR FOR WIDTHS ETC. INTSW = INT+2. ;STATE OF ACCUM - 0=EMPTY,1=POS NUM,-1=NEG EXITSW = INTSW+2. ;1 IF ITEMS NOT CVTD,0 IF ITEMS CVTD GRPCTS = EXITSW+2. ;SAVED UNEXHAUSTED HIGHEST NEST GROUP REP GRPCTI = GRPCTS+2. ;INITIAL HIGHEST LEVEL NEST GROUP REP CNT GRPCT = GRPCTI+2. ;CURRENTLY ACTIVE GROUP REPETITION COUNT NPRN2 = GRPCT+2. ;PTR TO LOWEST NESTING (IN FMT STMT) NPRN1 = NPRN2+2. ;PTR T ; ; THIS IS THE MAP ONTO THE I/O BUFF ($IOBUF) ; BFLP=0. ;LINK PTR BFLKER=BFLP-2. ;LINK BLOCK ERR RTN ADDR BFLDSN=BFLP+2. ;LOG DATASET NAME BFUNUM=BFLP+5. ;UNIT NUM BORD NUMBER (IF RANDOM IO) UFNULL = FMTADR ;0 (IF UNFORMATTED IO) UNITAD = FMTADR+2. ;ADDRESS OF IO UNIT NUMBER ; ; IOPSTK = UNITAD+2. ;LENGTH OF GENERAL STACK TABLE ; ; O HIGHEST NESTING (IN FMT STMT) NEST = NPRN1+2. ;NESTING LEVEL FMTPTR = NEST+2. ;ADDRESS OF CURRENT POS IN FORMAT STMT ; ; IOFSTK = FMTPTR+2. ;LENGTH OF FORMATTED I/O STACK TABLE ; FPDVN=BFLP+6. ;PHYSICAL DEVICE NAME BFFLER=BFLP+8. ;FILE BLOCK ERR RTN ADDR BFHOPN=BFFLER+2. ;HOW OPEN BFERCD=BFFLER+3. ;ERROR CODE BFFLNM=BFFLER+4. ;FILE NAME AND EXTENSION BFUIC=BFFLER+10. ;UIC BFPC=BFFLER+12. ;PROTECT CODE BFMCNT=BFFLER+14. ;BUFF HEADER MAX BYTE COUNT BFMODE=BFMCNT+2. ;MODE BFSTAT=BFMCNT+3. ;STATUS BFACNT=BFMCNT+4. ;ACTUAL BYTE COUNT BFPTR=BFMCNT+6. ;BUFFER START ; ; BFLEN=136. ;LENGTH OF BUFFER ; ӠӠŠРϠŠŠٍнˠҍνЫ̠ŠōνЫנ΍ͽЫԠ͍ͽЫŠŠĠ΍ýЫԠō׽ЫŠӠӍŽЫōԽЫ .TITLE IOFI01 ; ; $IOFI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INFI,$OUTFI .GLOBL $FIO,$INFR,$OUTFW .CSECT ; ; THIS ROUTINE IS CALLED TO INITIALIZE FORMATTED I/O ; ; CALLING SEQUENCE ; ;  PUSH ADDR OF UNIT NUM ;  PUSH ADDR OF FORMAT STMT ;  JMP ($INFI,$OUTFI) ; ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; ; ; ; ; $INFI: MOV #1.,-(SP) ;SET IOSW FOR INPUT BR IOFI   .TITLE $FIO02 .CSECT .GLOBL $FIO,$IOELM,$ERRA ; ; THIS ROUTINE DOES FORMAT SCANNING AND I/O ITEM CONVERSION ; ; $FIO V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 .GLOBL $DCI,$DCO,$RCI,$ECO,$FCO .GLOBL $GCO,$ICI,$ICO,$LCI,$LCO,$OCI,$OCO ; ; ; ; ; ; $FIO: TST FMTPTR(R5)  ;IS THIS INIT CALL BEQ FIO1   ;BRANCH IF IS JMP REENT   ;ELSE RETURN TO ӍԽЫĠԍýЫÍĽЫҠҠҠ̩͠Ľʼn͠àčνī͠ˠ͍ī͠ˠҍ̽ī͠ˠ΍Ľī͠àҠҍؽīؠӠΠōνīĠȍ$OUTFI: CLR -(SP)  ;SET IOSW FOR OUTPUT IOFI: MOV #$FIO,-(SP) ;SET IOADDR=$FIO CLR -(SP)  ;SET IOTSW=0=FMTD I/O MOV #$INFR,-(SP) ;SET IOTADR=$INFR=INPUT TST IOSW-IOTADR(SP) ;CHECK IF INPUT BNE IOFI1  ;BRANCH IF INPUT MOV #$OUTFW,(SP) ;ELSE SET IOADR=$OUTFR=OUTPUT IOFI1: CLR -(SP)  ;CLEAR RECADR,RECPTR,RECEND, CLR -(SP)  ;ARGPTR,ARGTYP,ARGLGN CLR -(SP) CLR -(SP) CLR -(SP) CLR -(SP) MOV R4,-(SP) ;SAVE PTR TO END=, ERR= ADDRS CLR -(SP)  PLACE OF EXIT ; FIO1: MOV FMTADR(R4),FMTPTR(R5) ;INITIALIZE SCAN OF FORMAT MOVB @FMTPTR(R5),SCNKAR(R5) ;GET FIRST CHAR OF FORMAT CMPB #'(,SCNKAR(R5)  ;VALIDATE OPENING ( BNE FIO2   ;IF NO (IS SYNTAX ERROR JMP LPARN FIO2: JMP BADSYN ; ; ; ; ; SCAN FORMAT ACCUMULATING NUMBER IN INT SETTING INTSW, SCNKAR ; AND FMTPOS PROPERLY AND STOPPING SCAN AT NONBLANK NONNUMBER ; SCAN: CLR R0 CLR INT(R5)  ;ZERO ACCUMULATOR AND STATUS CLR INTSW(R5) SCAN1: INC FMTPTR(R .TITLE $IOF01 ; ; $IOF V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $IOF,$IOFX,$IOUD,$IORD,$IOERR .GLOBL $ERRA,$EXIT .CSECT ; ; THIS ROUTINE IS CALLED AT THE END OF I/O LIST PROCESSING FOR ; FORMATTED,UNFORMATTED AND RANDOM I/O ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $IOF: MOV SP,R5  ;SET R5 TO POINT TO IOPSTK ADD (R5),R5 ADD #SAVER0+2.,R5 ;SAVE R0-R4 MOV R0,-(R5) MOV R;CLEAR ERRFLG MOV R0,-(SP) ;SAVE R0-R5 MOV R1,-(SP) ;NOTE R5 WILL BE RESTORED, AT MOV R2,-(SP) ;RETURN FROM FINALIZING CALL, MOV R3,-(SP) ;TO VALUE SAVED HERE MOV R4,-(SP) MOV R5,-(SP) ;IOPSTK HAS NOW BEEN ALLOCATED MOV SP,R4  ;SET R4 TO POINT TO IOPSTK ; MOV #IOFSTK,R5 ;NOW ALLOCATE I/O SPECIFIC STACK ASR R5  ;IOFSTK IOFI2: CLR -(SP)  ;CLEAR IOFSTK DEC R5 BNE IOFI2 MOV SP,R5  ;SET R5 TO POINT TO IOFSTK ; MOV #IOFSTK+2.,-(SP) ;PUSH S5)  ;ADVANCE TO NEXT FMT LOCN MOVB @FMTPTR(R5),R1  ;GET CHAR WHICH IS THERE CMPB #' ,R1   ;IGNORE BLANKS BEQ SCAN1 TST INTSW(R5)  ;IF THIS IS FIRST NON-BLANK BNE SCAN2   ;CHECK IF IS -, ELSE BRANCH CMPB #'-,R1 BNE SCAN2   ;IF NOT -, BRANCH DEC INTSW(R5)  ;ELSE SET STATUS = -1(NEG NUM) BR SCAN1   ;AND IGNORE - SCAN2: SUB #60,R1   ;CHECK IF CHAR IS A DIGIT (0-9) BMI SCANX   ;IF NOT GO EXIT CMP #9.,R1 BLT SCANX TST INTSW(R5)  1,-(R5) MOV R2,-(R5) MOV R3,-(R5) MOV R4,-(R5) TST -(R5) MOV R5,R4  ;SET R4 TO POINT TO IOPSTK MOV SP,R5  ;SET R5 TO POINT TO I/O SPECIFIC TST (R5)+  ;STACK CLR ARGPTR(R4) ;CLEAR OUT ARG ADDR, LEN AND TYPE CLR ARGLEN(R4) CLR ARGTYP(R4) TST IOTSW(R4) ;DETERMINE TYPE OF I/O    ;AND GO PROCESS BEQ IOFD BLT IORD JMP $IOUD  ;PROCESS UNFORMATTED IORD: JMP $IORD  ;PROCESS RANDOM ; ; COME HERE TO PROCESS FORMATTED I/O ; IOFD: TST  .TITLE INFR01 ; ; $INFR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INFR, $OUTFW, $IOBUF, $OPEN, $CLOSE, $READ .GLOBL $WRITE,$FNDEV,$IOSET,$IOERR .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE CONTROLS FORMATTED INPUT/OUTPUT ; $INFR: $OUTFW: MOV @UNITAD(R4),R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET DEVICE TBL ENTRY PTR IN R1 TST R1 BNE INFRX1 MOV #14,R3  ;SET R3 TO INDICATE INVALID DEVICE JMIZE OF IOFSTK+2 ONTO STK ; JSR PC,@IOTADR(R4) ;GO INITIALIZE I/O ; MOV R4,R0  ;RESTORE CALLERS R0-R5 AND MOV (R0)+,R5  ;RETURN TO MAIN IN EXPECTATION MOV (R0)+,R4 ;OF ARG AND END CALLS MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 CMP (R4)+,(R4)+ ;SPACE OVER END=,ERR= ADDRS JMP @(R4)+ ; ;IF IS AND IS FIRST NON-BLANK BNE SCAN3   ;CHAR SET STATUS = 1 (POS NUM) INC INTSW(R5) SCAN3: ASL R0   ;MULTIPLY PREVIOUS ACCUMULATION ADD R0,R1   ;BY 10 AND ADD IN NEW DIGIT ASL R0 ASL R0 ADD R1,R0 BR SCAN1   ;GO GET NEXT CHAR ; SCANX: MOVB @FMTPTR(R5),SCNKAR(R5) ;RE-SET CURRENT CHAR TST INTSW(R5)  ;TEST IF NEG NUM BGE SCANX1 NEG R0   ;IF IS - NEGATE NUMBER SCANX1: MOV R0,INT(R5)  ;SAVE NUMBER RTS PC   ;RETURN TO CALLER ; ;ERRFLG(R4) ;CHECK IF ERROR CONDITIONS EXIST BNE $IOFX  ;FLUSH I/O LIST IF PRESENT JSR PC,@IOADDR(R4) ;CALL SPECIFIC I/O ROUTINE ; ; COME HERE TO FLUSH I/O LIST IF ANY ; AND RETURN TO CALLER ; $IOFX: MOV R4,R0 MOV R4,SP  ;FREE SPECIFIC I/O STACK MOV (R0)+,R5 ;RESTORE CALLERS R0-R5 MOV (R0)+,R4 ;NOTE R5 #S AS BEFORE INIT CALL MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 ADD #IOPSTK,SP ;FREE IOPSTK JMP @(R4)+  ;RETURN TO CALLER ; ; ;  P $IOERR  ;GO PROCESS THE ERROR ; ; INFRX1: MOV #$IOBUF,R2 ;GET ADDR OF I/O BUFFER IN R2 ; ; ; CHECK IF FIRST CALL ; TST RECADR(R4) BNE INFRS  ;BRANCH IF NOT FIRST CALL ; BITB #3,DVSW(R1) ;CHECK IF DEVICE OPEN BNE INFR2  ;BRANCH IF SO ; INFR1: JSR PC,$IOSET ;SET UP BUFFER FROM ENTRY ; JSR PC,$OPEN ;OPEN FILE TST R3 BEQ INFR2 TST R3  ;IF ERROR WAS NO SPACE FOR I/O BLT INFR1A  ;SIMPLY GO PROCESS ADD #3,R3  ;OTHERWISE SET R3 TO MSG NUM ! .TITLE IOUI01 ; ; $IOUI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INI,$OUTI,$UIO,$INR,$OUTW .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO INITIALIZE UNFORMATTED I/O ; ; CALLING SEQUENCE ; ;  PUSH ADDR OF UNIT NUM ;  JMP ($INI,$OUTI) ; $INI: CLR -(SP)  ;CLEAR UFNULL MOV #1,-(SP) ;SET IOSW TO INPUT BR IOUI $OUTI: CLR -(SP)  ;CLEAR UFNULL CLR -(SP)  ;SET IOSW TO OUTPUT " COME HERE TO DETERMINE WHERE TO GO ON BASIS OF NEXT CHAR IN ; FORMAT STMT ; ; VALID CHARS ARE T / , ) ' ELSE IS SYNTAX ERROR ; FCONT: MOV SCNKAR(R5),R1 CMPB #',,R1 BEQ JCOMMA CMPB #'),R1 BEQ JRPARN CMPB #'/,R1 BEQ JSLASH CMPB #'T,R1 BEQ JTSPEC CMP #'',R1 BEQ JQUOTE FCONTX: JMP BADSYN ; ; JCOMMA: JMP COMMA JRPARN: JMP RPARN JLPARN: JMP LPARN JSLASH: JMP SLASH JQUOTE: JMP QUOTE ; ; ; VALID CHARS ARE , ) ( / ' A D E F G H I L O P T X#I/O ROUTINES COME HERE TO PROCESS ERRORS ; ; $IOERR: MOV #1,R0 ;SET R0 IN ANTICIPATION OF CLASS 1 ERR TST R3  ;CHK IF NO SPACE ERR BGE IOERR0  ;BR IF SOME OTHER ERROR MOV #256.,R0 ;CALL ERROR CLASS=0/NUM=1 JSR R5,$ERRA IOERR0: CMP #4,R3  ;CHK EOM/EOF BNE IOERR1  ;BR IF OTHER JSR PC,IOERRS  ;GO PROCESS ERROR TST @ENDERR(R4) ;IF END= SPECIFIED GO PROCESS BNE ENDEQ IOERR2: JSR R5,$EXIT  ;OTHERWISE CALL EXIT IOERR1: JSR PC,IOERRS ;PROCESS ANY OTHER$ INFR1A: JMP $IOERR  ;AND GO PROCESS ; ; CHECK FOR COMPATABLE DEVICE STATUS ; INFR2: BITB #2,DVSW(R1) ;CHECK IF OPENED FOR FMTD I/O BEQ INFRX2 MOV #13,R3 ;INDICATE COMPATABILITY ERROR JMP $IOERR  ;AND GO PROCESS ; INFRX2: CMPB #4,DVHOPN(R1) ;IS FILE OPEN FOR INPUT BNE INFR4  ;BRANCH IF NOT TST IOSW(R4) ;IS STMT READ BNE INFR5  ;BRANCH IF SO INFR3: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR JSR PC,$CLOSE ;CLOSE FILE TST R3 BEQ INFR1  ;GO REOPEN %; IOUI: MOV #$UIO,-(SP) ;SET IOADDR = $UIO MOV #1,-(SP) ;SET IOTSW = 1 = UNFORMATTED MOV #$INR,-(SP) ;SET IOTADR = $INR = INPUT TST IOSW-IOTADR(SP) BNE IOUT1 MOV #$OUTW,(SP) ;IF OUTPUT, RESET IOTADR = $OUTW IOUT1: CLR -(SP)  ;CLEAR RECADR,RECPTR,RECEND,ARGPTR, CLR -(SP)  ;ARGTYP,ARGLEN CLR -(SP) CLR -(SP) CLR -(SP) CLR -(SP) MOV R4,-(SP) ;SAVE END=, ERR= ADDRS CLR -(SP)  ;CLEAR ERRFLG MOV R0,-(SP) ;SAVE R0-R5 MOV R1,-(SP) ;NOTE - R& = ALL SPECS ; ; FCONT1: CMPB #',,SCNKAR(R5) BEQ JCOMMA CMPB #'),SCNKAR(R5) BEQ JRPARN ; ; VALID CHARS ARE ( / ' A D E F G H I L O P T X ; FCONT2: MOV SCNKAR(R5),R1 CMPB #'(,R1 BEQ JLPARN CMPB #'/,R1 BEQ JSLASH CMPB #'',R1 BEQ JQUOTE ; ; SUB #101,R1   ;CHECK IF A LETTER BY SUBTRACT- BMI FCONTX   ;ING OCTAL VALUE OF 'A' AND CMP #25.,R1   ;TESTING IF IN RANGE (0.-25.) BLT FCONTX   ;ELSE IS SYNTAX ERROR CLR R0 MOVB CVTYPE(R' CLASS 1 ERROR JSR PC,IOERRX ;PREPARE TO TAKE ERR= EXIT MOV R4,SP  ;FREE SPECIFIC I/O STACK ADD #IOPSTK,SP  ;FREE IOPSTK MOV ENDERR(R4),R4 ;GET POINTER TO END=ERR= MOV 2(R4),R4 ;GET ERR ADDR BEQ IOERR2  ;CALL EXIT IF NOT SPECIFIED JMP @(R4)+  ;RETURN TO CALLER AT ADDR SPECIFIED ; ; ENDEQ: JSR PC,IOERRX ;PREPARE TO TAKE END=EXIT MOV R4,SP  ;FREE SPECIFIC I/O STACK ADD #IOPSTK,SP  ;FREE IOPSTK MOV ENDERR(R0),R4 ;GET POINTER TO END=ERR= MOV @R( JMP $IOERR  ;GO PROCESS A CLOSE ERROR TT: .RAD50 /KB / LP: .RAD50 /LP / ; INFR4: TST IOSW(R4) ;IS STMT WRITE BNE INFR3  ;BRANCH IF NOT TO CLOSE AND OPEN ; OUTFW1: MOV #BFLEN,R0  ;SET BUFF LEN MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV R2,R3 ADD #BFPTR,R3 ;SET BUFF START MOV R3,-(SP)  ;CLEAR BUFF OUTFW9: MOVB #' ,(R3)+ DEC R0 BNE OUTFW9 MOV #133.,R0 MOV (SP)+,R3 MOV R2,-(SP) EMT 13 TST (SP)+ CMP TT,(SP) ;IF DEVICE IS LP OR TT)5 WILL BE RESTORED TO VALUE MOV R2,-(SP) ;SAVED HERE AFTER FINALIZING CALL MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) ;IOPSTK HAS NOT BEEN ALLOCATED MOV SP,R4  ;IOPSTK IS ADDRESSED BY R4 ; MOV #IOUSTK,R5 ;ALLOCATE I/O SPECIFIC STACK ASR R5 IOUI2: CLR -(SP) DEC R5 BNE IOUI2 MOV SP,R5  ;IOUSTK IS ADDRESSED BY R5 MOV #IOUSTK+2,-(SP) ;PUSH SIZE OF IOFSTK+2 ONTO STACK INC IOSTAT(R5) ;FOR OUTPUT INIT AS FIRST SEG ; JSR PC,@IOTADR(R4) ;GO INITIALIZE *1),R0  ;GET ROUTINE NUMBER OR ZERO ASL R0   ;SET UP DISPLACEMENT FOR BRANCH ASL R0 ADD R0,PC   ;PERFORM BRANCH TO ROUTINE OR JMP BADSYN   ;SYNTAX ERROR JMP ASPEC JMP DSPEC JMP ESPEC JMP FSPEC JMP GSPEC JMP HSPEC JMP ISPEC JMP LSPEC JMP OSPEC JMP PFACT JTSPEC: JMP TSPEC JMP XSPEC ; ; INDEXING CVTYPE WITH 'A' GIVE ROUTINE NUMBER ; A=1,DEFGNI=2-7,L=8,O=9,P=10,T=11,X=12 CVTYPE: .BYTE 1.,0.,0.,2.,3.,4.,5.,6.,7.,0.,0.,8.,0.,0.,9.,+4,R4  ;GET END ADDR JMP @(R4)+  ;RETURN TO CALLER AT ADDR SPECIFIED ; ; IOERRS: TST DVARAD(R1) ;CHK IF ERR VAR ADDR SET BEQ IOERR3  ;BR IN NOT MOV R3,@DVARAD(R1) ;OTHERWISE ERR VAR = ERR NUM IOERR3: SWAB R3   ;CALL ERROR CLASS=(R0)/NUM=(R3) BIS R3,R0 JSR R5,$ERRA RTS PC  ;IF ERROR RETURNS CONTINUE PROCESSING ; ; IOERRX: MOV R4,R0 MOV (R0)+,R5 ;RESTORE CALLERS R1-R3,R5 TST (R0)+ MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 ,Y LEAVE BEQ INFR6  ;EXTRA CHAR CMP LP,(SP) BNE INFR7A INFR6: INC R3 INFR7A: CMP (SP)+,(SP)+ INFR7: MOV R3,RECADR(R4) ;SET BUFF PTRS ON STACK MOV R3,RECPTR(R4) ADD R0,R3 MOV R3,RECEND(R4) RTS PC  ;RETURN ; ; ; ; ; ; INFR5: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET MAX REC LEN ; JSR PC,$READ ;GO READ TST R3 BEQ INFR5X JMP $IOERR  ;GO PROCESS A READ ERROR ; INFR5X: INC DVRCNT(R1) ;INC RECORD COUNT ADD I/O ; MOV R4,R0  ;RESTORE CALLERS REGS R0-R5 MOV (R0)+,R5  ;AND RETURN IN EXPECTATION OF MOV (R0)+,R4 ;ARG AND END CALLS MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 CMP (R4)+,(R4)+ ;SPACE OVER END=,ERR= ADDRS JMP @(R4)+ ; ; .10. .BYTE 0.,0.,0.,11.,0.,0.,0.,12.,0.,0. ; ; ; COMMA COMES HERE ; COMMA: TST INTSW(R5)  ;NO PRECEEDING NUM ALLOWED BEQ COMMA1 JMP BADSYN COMMA1: JSR PC,SCAN   ;GO GET NEXT NUMAND SPEC JMP FCONT2   ;ALLOW ALL SPECS BUT ) AND , ; ; P COMES HERE ; PFACT: TST INTSW(R5)  ;PRECEEDING NUM REQUIRED BNE PFACT1 JMP BADSYN PFACT1: MOV INT(R5),PSCALE(R5) ;SAVE SCALING JSR PC,SCAN   ;GET NEXT NUM AND SPEC JMP FCONT1   ;ALLOW ANY SPEC TO FOLLOW ; ;RESTORE R0 RTS PC  ;RETURN TO COMPLETE EXIT 0#BFPTR,R2 ;ADDR DATA MOV R2,R1 ADD -2(R2),R2 ;ADDR END OF DATA+1 DEC R2 MOV R1,R3 CMPB #11,(R2) ;DELETE LF,VT,FF BHI INFR8X CMPB #15,(R2) BLO INFR8X DEC R2 CMPB #15,(R2) ;DELETE CR BEQ INFR8 INFR8X: INC R2 INFR8: MOV #133.,R0 ADD R0,R1 INFR9: CMP R1,R2  ;PAD BUFF WITH BLANKS IF NECESSARY BLOS INFR7 MOVB #' ,(R2)+ BR INFR9 ; ; NON-FIRST CALL COMES HERE ; INFRS: TST IOSW(R4) BNE INFR5  ;BRANCH IF READ ; MOV DVLP(R1)1 .TITLE $UIO03 .GLOBL $UIO,$IOELM,$ERRA .CSECT ; ; $UIO V003A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE DOES ITEM TRANSFERS TO OR FROM INFORMATTED I/O ; RECORD ; $UIO: MOV RECPTR(R4),R2 ;GET RECORD LOC TST IOSW(R4) BEQ UIO1  ;BRANCH IF OUTPUTTING ITEMS ; MOV ARGLEN(R4),R0 MOV ARGPTR(R4),R1 UIO2: CMP R2,RECEND(R4) ;IF INPUT, CHECK IF SEGMENT DONE BLO UIO4  2; ; ; ; T SPEC COMES HERE ; TSPEC: TST INTSW(R5)  ;NO PRECEEDING NUM ALLOWED BEQ TSPEC1 TSPECX: JMP BADSYN TSPEC1: JSR PC,SCAN   ;GET TAB POSITION AND NEXT SPEC TST INT(R5)   ;MUST BE NON-ZERO POSITIVE TAB BLE TSPECZ   ;ELSE-ERROR DEC INT(R5) ADD RECADR(R4),INT(R5) CMP RECPTR(R4),TSPECO(R5) ;SET PTR TO HIGHEST POS REF BLOS TSPEC3 MOV RECPTR(R4),TSPECO(R5) TSPEC3: MOV INT(R5),RECPTR(R4) ;READJUST RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK 3 .TITLE IOUD01 ; ; $IOUD V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $IOUD,$IOFX .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED AT END OF I/O LIST PROCESSING FOR ; UNFORMATTED I/O ; ; $IOUD: TST IOSW(R4) ;BRANCH IF OUTPUT BEQ IOD1 IOD: BIT IOSTAT(R5),#2 ;IF INPUT FLUSH REST OF REC BNE IODX  ;BRANCH IF DONE JSR PC,@IOTADR(R4) ;GET NEXT SEGMENT BR IOD  ;GO CHECK IF DONE ; IOD4,BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET BUFF LEN ; MOV R2,-(SP) EMT 13 TST (SP)+ MOV (SP)+,R3 TST (SP)+ CMP TT,R3 ;IF LP OR TT BEQ OUTFWP  ;BRANCH TO DO SPACING CMP LP,R3 BEQ OUTFWP ; MOVB #15,@RECPTR(R4) ;ELSE APPEND CR AND LF INC RECPTR(R4) MOVB #12,@RECPTR(R4) OUTFW2: SUB RECADR(R4),RECPTR(R4) INC RECPTR(R4) MOV RECPTR(R4),BFACNT(R2) ;SET RECORD LENGTH JSR PC,$WRITE ;WRITE RECORD TST R3  ;BRANCH IF ERRORS 5;BRANCH IF NOT BIT IOSTAT(R5),#2 ;CHECK IF LAST SEGMENT BNE SHORT  ;ERROR IF SO (SHORT RECORD) ; MOV R1,-(SP) MOV R0,-(SP) JSR PC,@IOTADR(R4) ;IF NOT LAST, GET NEXT SEGMENT MOV (SP)+,R0 MOV (SP)+,R1 MOV RECPTR(R4),R2 ; UIO4: MOVB (R2)+,(R1)+ ;MOVE BYTES FROM REC TO ITEM DEC R0 BNE UIO2 UIO5: MOV R2,RECPTR(R4) ;RESET RECORD PTR RTS PC  ;RETURN TO CALLER ; ; SHORT: MOV #770.,R0 ;SHORT RECORD ERR (MORE ITEMS THAN REC) JSR R5,$ERRA ;CALL E6IF IN BOUNDS OF BUFFER BLO TSPEC2   ;BRANCH IF IN BOUNDS TSPECZ: JMP BADTAB   ;ERROR - SPEC OUTSIDE RECORD TSPEC2: CLR INT(R5)   ;RESET ACCUMULATOR AND STATUS CLR INTSW(R5) JMP FCONT   ;ALLOW T / , ) ' SPECS TO FOLLOW ; ; ; ; ; X SPEC COMES HERE ; XSPEC: TST INTSW(R5)  ;EITHER THERE MUST BE NO PRECEED BEQ XSPEC1   ;ING NUM OR IT MUST BE POSITIVE BGT XSPEC2   ;NONZERO XSPECX: JMP BADSYN   ;ELSE-ERROR XSPEC1: INC INT(R5)   ;IF ABSENT SET TO1: BIS #2,IOSTAT(R5) ;SET FIRST AND LAST OR JUST LAST REC IOD2: JSR PC,@IOTADR(R4) ;GO WRITE LAST SEGMENT ; ; IODX: JMP $IOFX  ;GO FINISH UP & RETURN TO CALLER ; ; FBNE WRITER INC DVRCNT(R1) ;INC RECORD COUNT BR OUTFW1  ;GO CLEANUP AND RETURN ; OUTFWP: MOVB #15,@RECPTR(R4) ;APPEND CR AND VT INC RECPTR(R4) MOVB #13,@RECPTR(R4) CLRB BFPTR(R2) CMPB BFPTR+1(R2),#'+ ;CHECK IF SPACE SUPPRESS BNE OUTFW3  ;BRANCH IF NOT OUTFW5: CLR BFPTR(R2) ;WRITE RECORD WITH 2 NULLS DEC RECADR(R4) BR OUTFW2 OUTFW3: CMPB BFPTR+1(R2),#'1 ;CHECK IF FORM FEED BNE OUTFW4  ;BRANCH IF NOT MOV #6015,BFPTR(R2) ;SET CR AND FF BR GRROR CLASS=2/NUM=3 INC ERRFLG(R4) ;IF ERR RET'S SET FLAG JMP $IOELM  ;AND GO FLUSH I/O LIST ; ; UIO1: MOV RECEND(R4),R3 ;IF OUTPUT, CHECK IF ITEM WILL OVERFLOW SUB R2,R3  ;BUFFER. SUB ARGLEN(R4),R3 BGT UIO6  ;BRANCH IF NOT ; JSR PC,@IOTADR(R4) ;WRITE THIS SEGMENT CLR IOSTAT(R5) ;SET TO NEITHER FIRST NOR LAST REC UIO6: MOV ARGLEN(R4),R0 MOV ARGPTR(R4),R1 MOV RECPTR(R4),R2 ;RESET REC PTR UIO3: MOVB (R1)+,(R2)+ ;MOVE BYTES TO REC FROM ITEM DEC E 1 XSPEC2: TST INT(R5)  BEQ XSPECX   ;IF ZERO - ERROR ADD INT(R5),RECPTR(R4) ;SET NEW RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK IF IN BOUNDS OF BUFFER BLOS XSPEC3 JMP BADTAB   ;ELSE ERROR XSPEC3: JSR PC,SCAN   ;GET NEXT NUM AND SPEC JMP FCONT1   ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; H SPEC COMES HERE ; HSPEC: TST INT(R5)   ;COUNT MUST BE PRESENT AND BGT HSPEC1   ;GREATER THAN 0 JMP BADSYN   ;ELSE - ERROR ; HSPEC1: MOV RECPTR(R4),R0 H .TITLE $INR01 ; ; $INR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INR, $OUTW, $IOBUF, $OPEN, $CLOSE, $READ, $WRITE .GLOBL $FNDEV,$IOSET,$IOERR .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE CONTROLS UNFORMATTED I/O ; $INR: $OUTW: MOV @UNITAD(R4),R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET TABLE ENTRY INTO R1 TST R1 BEQ BADEV  ;BRANCH IF BAD DEVICE NUM ; ; ; MOV #$IOBUF,R2 ;GET ADDR IOBUF IN R2 "D "@DDDDD """""""""""@ " "DDDDDDDDDDDD"""@@"D"@D"""DADDB C:y4d :y4d :y4d:y4d:0xQP}xQ :=4d &4d":X4d+v:Ou4d F:=4d)4d-G:4d/3:X4d7X:=4dJVq4dKW:4dZ^:Ou4d[sz804d\ X4dbntO*4drvO4dwE`O\4dz'O4d X4dyh4d=d{4d&4drV4dρ4dIq4d$4dwO4dwOu4dWX4dwX4db4dkb4db4dk=4d=4d=4d""4d4d`O4d""4d #Ё4d=;с4dT4d:O*4d$Dﮊ|C%%8a ͋,L w6B ` 5 &  }E >u   d5cU@  Y*  & * D &( 5I'4b Q$ BBB"   U@ e  "U%Gef. U U Bb 0 * BI ;SET UP TO DO MOVE MOV FMTPTR(R5),R1 MOV INT(R5),R2 ADD R2,RECPTR(R4)  ;RESET RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK IF RECORD OVERFLOW BLOS HSPEC2 JMP BADTAB HSPEC2: INC R1   ;GET NEXT FMT POSITN TST IOSW(R4)  ;MOVE TO OR FROM RECORD DEPEND- BEQ HSPEC3   ;ING ON IOSW MOVB (R0)+,(R1)  ;MOVE FROM RECORD BR HSPEC4 HSPEC3: MOVB (R1),(R0)+  ;MOVE TO RECORD HSPEC4: DEC R2   ;CHECK IF DONE BNE HSPEC2   ;IF NOT GO GET NEXT CHAR OUTFWX OUTFW4: MOVB BFPTR+1(R2),R3 ;CHECK IF 2 SPACES MOV #5015,BFPTR(R2) ;SET CR AND LF CMPB R3,#'0 BNE OUTFWX  ;BRANCH IF NOT TO 1 SPACE MOV #2,BFACNT(R2) JSR PC,$WRITE ;WRITE FIRST SPACER TST R3 BNE WRITER OUTFWX: MOV #2,BFACNT(R2) JSR PC,$WRITE ;WRITE SPACER TST R3  ;CHECK ERROR BNE WRITER BR OUTFW5  ;GO WRITE DATA ; ; ; WRITER: JMP $IOERR  ;GO PROCESS A WRITE ERROR ; ; R0 BNE UIO3 BR UIO5  ;GO TO EXIT ; ; ; L ; ; ; CHECK IF FIRST CALL ; TST RECADR(R4) BNE INRS  ;BRANCH IF NOT INIT CALL ; BITB #3,DVSW(R1) ;CHECK IF DEVICE OPEN BNE INR2  ;BRANCH IF SO ; INR1: JSR PC,$IOSET ;SET UP TO OPEN ; JSR PC,$OPEN ;OPEN TST R3 BNE BADOPN  ;BRANCH IF ERRORS ; ; CHECK COMPATABLE DEVICE STATUS ; INR2: BITB #1,DVSW(R1) ;CHECK IF COMPATABLE FILE BNE COMPER  ;ERROR IF NOT ; CMP #4,DVHOPN(R1) ;CHECK IF OPENED FOR INPUT BNE INR4  ;BRANCH IF NOT TST IOSW(MMOV R1,FMTPTR(R5)  ;ELSE - SAVE NEW FMT PTR JSR PC,SCAN   ;GET NEXT NUM AND SPEC JMP FCONT1   ;ALLOW ALL SPECS TO FOLLOW ; ; ; /COMES HERE ; SLASH: TST INTSW(R5)  ;NO PRECEEDING NUM ALLOWED BEQ SLASH1 JMP BADSYN SLASH1: CMP RECPTR(R4),TSPECO(R5) ;SET HIGHEST POS REF IN REC BHIS SLASH3 MOV TSPECO(R5),RECPTR(R4) CLR TSPECO(R5) SLASH3: JSR PC,@IOTADR(R4)  ;GO TO $INFR OR $OUTFW TO RD/WT ; SLASH2: JSR PC,SCAN   ;GET NUM AND NEXT SPEC JMP FCONTN .TITLE IORI01 ; ; $IORI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INRI,$OUTRI .GLOBL $RIO,$INRR,$OUTRW .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO INITIALIZE RANDOM I/O ; ; CALLING SEQUENCE ; ;  PUSH ADDR OF UNIT NUM ;  PUSH ADR OF RECORD NUMBER ;  JMP ($INRI,$OUTRI) ; ; ; $INRI: MOV #1,-(SP) ;SET IOSW = 1 = INPUT BR IORI $OUTRI: CLR -(SP)  ;SET IOSW = 0 = OUTPUT IO .TITLE $RIO02 .GLOBL $RIO,$IOELM,$ERRA .CSECT ; ; $RIO V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; THIS ROUTINE DOES TRANSFERS TO OR FROM RANDOM I/O RECORD ; $RIO: MOV ARGLEN(R4),R0 ;GET NUM BYTES TO TRANSFER MOV ARGPTR(R4),R1 ;GET ITEM LOC MOV RECPTR(R4),R2 ;GET RECORD BUFFER LOC MOV R2,R3  ;SET RECORD BUFFER LOC IN R3 TST IOSW(R4) ;IF OUTPUT REVERSE R1 AND R2 BNE RIOPR4) ;CHECK IF WRITE STMT BNE INR5  ;BRANCH IF NOT ; ; INR3: MOV DVLP(R1),BFLP(R2) ;CLOSE FILE JSR PC,$CLOSE TST R3 BNE INRERR  ;CHECK ERRORS BR INR1  ;GO REOPEN ; INR4: TST IOSW(R4) ;CHECK IF WRITE STMT BNE INR3  ;BRANCH IF NOT ; INR7: MOV #124.,R0 ;LENGTH OF DATA AREA MOV R2,R3 ADD #BFPTR,R3 ;ADDR OF BUFFER MOV IOSTAT(R5),(R3)+;SET CONTROL WORD INR6: MOV R3,RECADR(R4) ;SET BUFF PTR MOV R3,RECPTR(R4) ;SET BUFF END+1 ADD R0,R3 Q1   ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; ; ' COMES HERE ; QUOTE: TST INTSW(R5)  ;NO PRECEEDING NUM ALLOWED BEQ QUOTE1 JMP BADSYN QUOTE1: MOV RECPTR(R4),R0  ;SET UP TO DO MOVE MOV FMTPTR(R5),R1 ; QUOTE2: INC R1   ;STEP TO NEXT FORMAT POSITION CMPB #'',(R1)  ;CHECK IF ' BEQ QUOTE6   ;IF SO GO CHECK IF PAIRED OR END QUOTE3: CMP R0,RECEND(R4)  ;CHECK IF RECORD BUFF OVERFLOW BLO QUOTE4   ;BRANCH IF NOT JMP BADTAB QUOTE4: TST IOSW(R4)  ;MOVE RORI: MOV #$RIO,-(SP) ;SET IOADR = $RIO MOV #-1,-(SP) ;SET IOTSW = -1 = RANDOM MOV #$INRR,-(SP) ;SET IOTADR = $INRR = INPUT TST IOSW-IOTADR(SP) BNE IORI1 MOV #$OUTRW,(SP) ;IF OUTPUT RESET IOTADR = $OUTRW IORI1: CLR -(SP)  ;CLEAR RECADR,RECPTR,RECEND,ARGPTR, CLR -(SP)  ;ARGTYP,ARGLEN CLR -(SP) CLR -(SP) CLR -(SP) CLR -(SP) MOV R4,-(SP) ;SAVE END=,ERR= ADDRS CLR -(SP)  ;CLEAR ERRFLG MOV R0,-(SP) ;SAVE R0-R5 MOV R1,-(SP) ;NOTE - R5 WILLS1 MOV R1,R2 MOV R3,R1 ; ; ; RIO1: CMP R3,RECEND(R4) ;CHECK IF BUFFER EMPTY BLO RIO3  ;BRANCH IF NOT TST LENMAX(R5) ;CHECK IF ANY MORE CHARS IN REC BEQ SHORT  ;BRANCH IF NOT - ERROR SHORT RECORD ; MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) JSR PC,@IOTADR(R4) ;ELSE GET NEXT BUFFER OF REC MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 ; MOV RECPTR(R4),R3 ;RESET RECPTR IN PROPER REGS TST IOSW(R4) BEQ RIO2 MOV R3,R2 BR RIO1 RIO2: MOV R3TMOV R3,RECEND(R4) ;SET BUFF END+1 RTS PC  ;RETURN ; ; INR5: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET BUFF LEN ; JSR PC,$READ ;READ TST R3  ;CHECK IF ERRORS BNE INRERR ADD #BFACNT,R2 ;ADBR BYTE COUNT MOV (R2)+,R0 ;PUT COUNT IN R0, ADDR CONTROL WORD BIT #2,(R2) BEQ INR5A INC DVRCNT(R1) ;INC RECORD COUNT IF LAST SEG INR5A: MOV (R2)+,IOSTAT(R5);SET CONTROL WORD, ADD N DATA DEC R0  ;ADJUST COUNT BY LEN CNTRL WRD DEC R0UTO OR FROM RECORD BUFFER BEQ QUOTE5   ;DEPENDING ON IOSW MOVB (R0)+,(R1)  ;MOVE FROM RECORD BUFFER (INPUT) BR QUOTE2   ;GO GET NEXT FMT CHAR QUOTE5: MOVB (R1),(R0)+ ;MOVE TO RECORD BUFFER (OUTPUT) BR QUOTE2   ;GO GET NEXT FMT CHAR QUOTE6: CMPB #'',1(R1) BNE QUOTEX   ;BRANCH IF END QUOTE TST IOSW(R4)  ;ELSE - CHECK IF INPUT OR OUTPUT BNE QUOTE7 INC R1   ;IF OUTPUT, PUT OUT ONLY 1 QUOTE BR QUOTE3 QUOTE7: CLRB 1(R1)   ;IF INPUT, READ INTO BOV BE RESTORED TO VALUE MOV R2,-(SP) ;SAVE HERE AFTER FINALIZING CALL MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) ;IOPSTK HAS NOW BEEN ALLOCATED MOV SP,R4  ;IOPSTK IS ADDRESSED BY R4 ; MOV #IORSTK,R5 ;ALLOCATE I/O SPECIFIC STACK ASR R5 IORI2: CLR -(SP) DEC R5 BNE IORI2 MOV SP,R5  ;IORSTK IS ADDRESSED BY R5 MOV #IORSTK+2.,-(SP);PUSH SIZE OF IORSTK+2 ONTO STACK ; JSR PC,@IOTADR(R4) ;GO INITIALIZE I/0 ; MOV R4,R0  ;RESTORE CALLERS REGS R0-R5 MOVW,R1 BR RIO1 ; RIO3: MOVB (R2)+,(R1)+ ;MOVE CHARS TO/FROM REC INC R3  ;INC BUFFER PTR DEC LENMAX(R5) ;DEC NUM CHARS IN REC REMAINING DEC R0  ;CHECK IF ITEM TRANSFER DONE BNE RIO1  ;BRANCH IF NOT ; MOV R3,RECPTR(R4) ;RESTORE RECORD BUFFER PTR RTS PC  ;RETURN TO CALLER ; ; SHORT: MOV #770.,R0 ;ERROR - SHORT REC (MORE ITEMS THAN REC) JSR R5,$ERRA ;CALL ERROR CLASS=2/NUM=3 INC ERRFLG(R4) ;IF ERROR RET'S SET FLG JMP $IOELM  ;AND GO FLUSH I/O LISTX MOV R2,R3 BR INR6  ;GO CLEANUP AND RETURN ; ; INRS: TST IOSW(R4) ;NON-FIRST CALL COMES HERE BNE INR5  ;BRANCH IF READ ; MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET BUFF LEN MOV IOSTAT(R5),BFPTR(R2) ;PUT IN CONTROL WORD SUB RECADR(R4),RECPTR(R4) MOV RECPTR(R4),BFACNT(R2) ;SET DATA LENGTH INC BFACNT(R2) ;PLUS CNTRL WD LEN INC BFACNT(R2) JSR PC,$WRITE ;WRITE RECORD TST R3 BNE INRERR  ;BRANCH IF ERRORS ; BIT #2,IOSYTH QUOTES BR QUOTE3 ; QUOTEX: MOV R1,FMTPTR(R5)  ;SET NEW FMT AND RECORD PTRS MOV R0,RECPTR(R4) JSR PC,SCAN   ;GET NEXT NUM AND SPEC JMP FCONT1   ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; ; ( COMES HERE ; LPARN: TST INTSW(R5)  ;IF PRECEEDING NUM IS PRESENT BEQ LPARN1   ;IT MUST BE POSITIVE NON-ZERO BGT LPARN2 LPARNX: JMP BADSYN LPARN1: INC INT(R5)   ;IF ABSENT SET TO 1 LPARN2: TST INT(R5) BEQ LPARNX ; TST NEST(R5)  ;CHECK IF THIS FIRST CAL (R0)+,R5  ;AND RETURN IN EXPECTATION OF MOV (R0)+,R4 ;ARG AND END CALL MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 CMP (R4)+,(R4)+  ;SPACE OVER END=,ERR= ADDRS JMP @(R4)+ ; ; ; ; TAT(R5) ;INC RECORD COUNT IF LAST SEGMENT BEQ INR7 INC DVRCNT(R1) BR INR7  ;GO CLEAN UPAND RETURN ; ; BADEV: MOV #14,R3  ;SET R3 TO BAD DEVICE INRERR: JMP $IOERR  ;GO PROCESS THE ERROR BADOPN: TST R3  ;CHK FOR NO SPACE ERR BLT INRERR  ;BR IF PRESENT ADD #3,R3  ;OTHERWISE SET R3 TO PROPER NUM BR INRERR   COMPER: MOV #13,R3  ;SET R3 TO COMPATABILITY ERR BR INRERR ; ; ]L BEQ LPARNS   ;BRANCH IF SO CMP #2,NEST(R5)  ;CHECK WHICH IS CURRENT LEVEL BHI LPARNH   ;HIGHEST LEVEL - BRANCH BEQ LPARNL   ;LOWEST LEVEL - BRANCH MOV #258.,R0  ;ERROR - NESTING TOO DEEP JMP FIOERR   ;CLASS=2/NUM=1 ; LPARNH: MOV FMTPTR(R5),NPRN1(R5) ;SAVE FMT LOCN WHERE NEST STARTS MOV INT(R5),GRPCTI(R5) ;SAVE HIGHEST LEVEL GROUP REP LPARNS: INC EXITSW(R5)  ;SET NO CONVERTS DONE SWITCH LPARN3: MOV INT(R5),GRPCT(R5) ;SET CURRENT GROUP REP COUNT ^ .TITLE IORD01 ; ; $IORD V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $IORD,$IOFX .CSECT ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; THIS ROUTINE IS CALLED AT END OF I/O LIST PROCESSING FOR ; RANDOM I/O ; $IORD: TST IOSW(R4) ;INPUT OR OUTPUT?? BNE IORD2  ;BRANCH IF INPUT IORD3: MOV RECPTR(R4),R0 ;GET BUFF PTR MOV RECEND(R4),R1 ;GET END OF BUFF IORD4: CMP R0,R1  ;CHECK IF BUFF F_ .TITLE INRR01 ; ; $INRR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $INRR, $OUTRW, $FNDEV, $IOBUF, $OPEN, $CLOSE .GLOBL $READ,$WRITE,$RANDM,$IOSET .GLOBL $IOERR .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE CONTROLS RANDOM I/O ; $INRR: $OUTRW: MOV @UNITAD(R4),R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GOT ADDR OF ENTRY INTO R1 TST R1  ;BRANCH IF ERROR BEQ BADEV ; MOV #$IOBUF,R2 ;GET BUFR ADDR INT` .TITLE IARG01 ; ; $IOARG V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $IOB,$IOI,$IOJ,$IOR,$IOC,$IOD,$IOA,$MLI .GLOBL $IOELM .CSECT ; ; CALLING SEQUENCE - ; ;  PUSH N ARG PTRS ;  PUSH N ;  JMP ($IOB,$IOI,$IOJ,$IOR,$IOC,$IOD) ; ; ; NOTE - R5 IS DESTROYED ACCROSS CALLS TO THIS ROUTINE R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $IOA: CLR -(SP)  ;SET ARRAG ARG TYPE BR IOELEM ; $Ia INC NEST(R5)  ;SET NEW NESTING LEVEL JSR PC,SCAN  ;GET NEXT NUM AND SPEC JMP FCONT2   ;ALLOW ANY SPECS BUT ), ; LPARNL: MOV FMTPTR(R5),NPRN2(R5) ;SAVE FMT LOCN WHERE NEST STARTS MOV GRPCT(R5),GRPCTS(R5) ;SAVE UNEXHAUSTED HIGHER REP CNT BR LPARN3   ;GO SET NEST AND CURRENT REP CNT ; ; ; ; ; ) COMES HERE ; RPARN: TST INTSW(R5)  ;NO NUMBER MAY PRECEED BEQ RPARN1 JMP BADSYN RPARN1: CMP #2,NEST(R5)  ;BRANCH ON NESTING LEVEL BHI RPARNI   ;NO NESULL BEQ IORD1  ;BRANCH IF FULL DEC LENMAX(R5) ;DECREMENT REMAINING REC CHARS CLRB (R0)+ BR IORD4 IORD1: JSR PC,@IOTADR(R4) ;PUT/GET RECORD BUFFER TST LENMAX(R5) ; CHECK IF NO MORE CHARS IN REC BNE IORD3  ;GO CHECK IF MORE ; IORD2: MOV @RNUMAD(R4),R0 ;SET ASSOCIATED VAR TO CURRENT BLOCK+1 INC R0 MOV R0,@AVADDR(R5)  JMP $IOFX  ;GO FINISH UP & RETURN TO CALLER ; ; ; cO R2 ; TST RECADR(R4) ;CHECK IF FIRST CALL BNE INFRRS  ;BRANCH IF NOT ; ; BITB #3,DVSW(R1) ;CHECK IF OPEN BNE INRR2  ;BRANCH IF SO ; JSR PC,$IOSET ;SET UP FOR OPEN ; JSR PC,$OPEN ;OPEN(OPEN DO GET FOR BLKLEN) TST R3 BNE BADOPN  ;BRANCH IF ERRORS ; ; INRR2: BITB #2,DVSW(R1) ;CHECK IF RANDOM FILE BEQ COMPER  ;ERROR IF NOT BITB #1,DVSW(R1) BEQ COMPER ; MOV DVRLEN(R1),LENMAX(R5) ;SET RIO STACK REC LEN MOV DVAVAD(R1),AVADDR(R5) ;ASSOdOB: MOV #1.,-(SP) ;SET BYTE ARG TYPE BR IOELEM $IOI: MOV #2.,-(SP) ;SET INT*2 ARG TYPE BR IOELEM  $IOJ: MOV #4.,-(SP) ;SET INT*4 ARG TYPE BR IOELEM $IOR: MOV #5.,-(SP) ;SET REAL ARG TYPE BR IOELEM $IOD: MOV #8.,-(SP) ;SET DOUBLE PRECISION ARG TYPE BR IOELEM $IOC: MOV #6.,-(SP) ;SET COMPLEX ARG TYPE ; ; IOELEM: MOV 2(SP),R5 ;SET R5 TO ADDRESS IOPSTK ASL R5 ;STEP 0VER ITEMS, NUM ITEMS, CMP (R5)+,(R5)+ ;ARG TYPE ADD SP,R5 ADD (R5),R5  ;STEeTING - BRANCH BEQ RPARNH  ;HIGH NESTING ONLY DEC GRPCT(R5) ;CHECK IF GROUP REP EXHAUSTED BEQ RPARNL   ;BRANCH IF SO TO POP A LEVEL MOV NPRN2(R5),FMTPTR(R5) ;ELSE - REPEAT GROUP RPARN2: JSR PC,SCAN   ;GET NEXT NUM AND SPEC JMP FCONT1   ;ALLOW ANY TO FOLLOW RPARNL: MOV GRPCTS(R5),GRPCT(R5) ;RESET PREVIOUS REP REMAINING RPARN3: DEC NEST(R5)  ;POP A LEVEL BR RPARN2   ;GO CONTINUE SCAN RPARNH: DEC GRPCT(R5)  ;CHECK IF GROUP REP EXHAUSTED BEQ RPARN3 f .TITLE $BSP01 ; ; $BSP V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $BCKSP,$CLOSE,$IOSET,$OPEN,$READ,$IOBUF,$FNDEV .GLOBL $ERRA,$EXIT R0=0 R1=1 R2=2 R3=3 R4=4 R5=5 SP=6 PC=7 ; ;THIS ROUTINE DOES BACK SPACING IF FILE OPEN AND FMTD OR UNFMTD ;ELSE IGNORES ; $BCKSP: MOV (SP),R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET DEVTAB ENTRY ADDR TST R1 BEQ BADEV  ;BRANCH IF DEVICE NUM BAD MOVB DVSW(R1),R3 BIC #177774,R3  ;GET OPEN STgC VAR ADDR MOV DVRMAX(R1),RECMAX(R5) ;NUM RECS IN FILE MOV @RNUMAD(R4),-(SP) ;PUSH RECORD NUM BLE BADREC   ;ERROR IF LE 0 CMP (SP),RECMAX(R5)  ;OR GT MAX NUM RECS BHI BADREC DEC (SP)   ;DECREMENT TO DO BLOCK CALC MOV DVRLEN(R1),-(SP) ;PUSH RECORD LEN MOV DVBLKL(R1),-(SP) ;PUSH BLOCK LEN ; JSR PC,$RANDM  ;GET BLOCK NUM/DISP ON STACK ; TST (SP)+ MOV (SP)+,RECADR(R4) ;SAVE BLOCK DISP MOV (SP)+,R3 CMP R3,DVBLKN(R1)  ;CHECK IF BLOCK ALREADYhP OVER SPECIFIC I/O STACK ADD #SAVER0+2.,R5 ;NOW SAVE R0-R4 MOV R0,-(R5) MOV R1,-(R5) MOV R2,-(R5) MOV R3,-(R5) MOV R4,-(R5) TST -(R5) MOV R5,R4  ;SET R4 TO ADDRESS IOPSTK MOV 2(SP),R5 ;SET R5 TO ADDRESS SPECIFIC STK ASL R5 ADD SP,R5 CMP (R5)+,(R5)+ TST (R5)+   JSR PC,IOELM3  ;TEST IF FLUSHING REQUIRED MOV (SP)+,ARGTYP(R4) ;SAVE ARG TYPE BEQ IOARAY  ;BRANCH IF IS ARRAY MOV ARGTYP(R4),ARGLEN(R4) ;SET ARG LEN=ARG TYPE CMP #i  ;BRANCH IF SO TO POP A LEVEL MOV NPRN1(R5),FMTPTR(R5) ;ELSE - REPEAT GROUP BR RPARN2 ; RPARNI: TST ARGPTR(R4)  ;OUTERMOST , COMES HERE BNE RPARN5   ;BRANCH IF MORE IO LIST ITEMS ENDUPX: TST IOSW(R4)  ;WRITE OUT LAST RECORD IF OUTPUT BNE RPARN4 CMP RECPTR(R4),TSPECO(R5) BHIS ENDUPY MOV TSPECO(R5),RECPTR(R4) CLR TSPECO(R5) ENDUPY: JSR PC,@IOTADR(R4)  ;GO TO $OUTFW RPARN4: JMP ENDUP   ;GO TO EXIT RPARN5: TST EXITSW(R5)  ;CHECK IF FMT WILL CVTjATUS BNE BSP1  ;BRANCH IF FILE IPEN BSPX: TST (SP)+  ;IF FILE CLOSED, EXIT JMP @(R4)+ ; BSP1: CMP #3,R3 BEQ BSPX  ;IF RANDOM FILE, EXIT DEC R3 ; MOV #$IOBUF,R2 ;GET I/O BUFFER ADDR ; MOV DVRCNT(R1),-(SP) ;SAVE OLD RECORD COUNT MOV #1,-(SP) ;SET IOSW = INPUT MOV R4,-(SP) ;SAVE R4 MOV R3,-(SP) ;SET IOTSW = FMTD/UNFMTD MOV PC,R4  ;SET R4 TO SIMULATE IIPSTK SUB #IOTSW,R4 ;SETUP ON STACK ; MOV DVLP(R1),BFLP(R2) ;SET LINK PTR JSR PC,$CLOk IN BEQ INRR4   ;BRANCH IF SO MOV R3,DVBLKN(R1)  ;SET BLOCK NUM INRR5: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV DVBLKN(R1),BFMODE(R2) ;SET BLOCK NUM, ADDR, LEN MOV DVBLKA(R1),BFACNT(R2) MOV DVBLKL(R1),BFPTR(R2) JSR PC,$READ  ;READ BLOCK TST R3 BNE INRRER   ;BRANCH IF ERRORS MOV BFACNT(R2),DVBLKA(R1) ;SAVE BLOCK ADDR INRR4: MOV DVBLKA(R1),R3 MOV RECADR(R4),R0 MOV R0,R2 ADD R3,R0   ;ADDR OF DATA START MOV R0,RECADR(R4) MOV R0,RECPl4,ARGLEN(R4) BHIS IOELM1 BIC #3,ARGLEN(R4) ;IF ARGTYP=5 OR 6 ARGLEN=4 IOELM1: MOV (SP),R3 ;GET ADDRESS OF NEXT ARG ASL R3 ADD SP,R3 MOV (R3),ARGPTR(R4) ;SET IT IN ARGPTR IOCALL: JSR PC,@IOADDR(R4) ;CALL SPECIFIC IO ROUTINE JSR PC,IOELM3 ;CHECK IF ERR'S REQ I/O LIST FLUSHED CMP #6,ARGTYP(R4) ;IF WAS COMPLEX ARG BNE IOELM2  ;STEP TO IMAGINARY PORTION ADD #4,ARGPTR(R4) ;AND SEND TO IO ROUTINE JSR PC,@IOADDR(R4) JSR PC,IOELM3 ;CHECK IF ERR'S REQ I/O m REMAINING BEQ RPARN6   ;IO LIST ITEMS - BRANCH IF SO MOV #2,R0   ;ELSE - FORMAT ERROR JMP FIOERR   ;CLASS=2/NUM=0 RPARN6: CMP RECPTR(R4),TSPECO(R5) BHIS RPARNX MOV TSPECO(R5),RECPTR(R4) CLR TSPECO(R5) RPARNX: JSR PC,@IOTADR(R4)  ;GO TO READ NEXT OR WRITE LAST RPARN7: TST NPRN1(R5)  ;CHECK IF WAS EVER NESTED BNE RPARN8   ;BRANCH IF WAS MOV FMTADR(R4),FMTPTR(R5) ;REPEAT ENTIRE FMT RPARN9: INC EXITSW(R5)  ;RESET NON-CONVERT SWITCH BR RPARN2 nSE ;CLOSE FILE TST R3 BNE CLOSER  ;BRANCH IF ERRORS ; JSR PC,$IOSET ;SETUP TO REOPEN JSR PC,$OPEN ;REOPEN FILE FOR INPUT TST R3 BNE BADOPN  ;BRANCH IF ERRORS ; ; BSP2: DEC FMTADR(R4) BEQ BSPY  ;BRANCH IF POSITIONED PROPERLY ; BSP4: JSR PC,$READ ;READ A RECORD TST R3  ;CHECK IF ERRORS BNE BADRED  ;BRANCH IF SO ; TST IOTSW(R4) ;CHECK FMTD OR UNFMTD BNE BSP3  ;BRANCH IF UNFMTD FILE BSP5: INC DVRCNT(R1) ;COUNT RECORDS READ BR BSPoTR(R4) NEG R2   ;ADDR OF DATA START ADD DVBLKL(R1),R2  ;LENGTH TO END OF BLOCK CMP R2,LENMAX(R5)  ;IS REC LT AMT IN BLOCK BLOS INRR3   ;BRANCH IF NOT MOV LENMAX(R5),R2  ;USE REC LEN INRR3: ADD R0,R2   ;ADDR OF DATA END +1 MOV R2,RECEND(R4)  ;SET IT RTS PC   ;RETURN ; ; INFRRS: TST IOSW(R4)  ;NON-FIRST CALL COMES HERE BEQ OUTRW1   ;BRANCH IF IS WRITE STMT ; ; OUTRW2: INC DVBLKN(R1)  ;MUST READ NEXT BLOCK AND CLR RECADR(R4)  ;STARpLIST FLUSHED IOELM2: DEC (SP)  ;CHECK IF MORE ARGS BNE IOELM1  ;IF SO GO PROCESS $IOELM: TST -(R5)  ;ELSE - RESTORE CALLERS REGS AND MOV R5,SP  ;RESET THE STACK POINTER (REMOV- MOV R4,R0  ;ING ARGS) MOV (R0)+,R5  ;LEAVE IOPSTK AND IO SPECIFIC MOV (R0)+,R4 ;STACK IN ANTICIPATION OF MORE MOV (R0)+,R3 ;ARGS FOR AN END CALL MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 JMP @(R4)+  ;EXIT TO CALLER ; ; COME HERE TO CHECK IF ERROR CONDITIONS PRESENT ; Iq  ;GO CONTINUE SCAN RPARN8: MOV GRPCTI(R5),GRPCT(R5) ;RESET NEXTING ORIGINAL GROUP CT MOV NPRN1(R5),FMTPTR(R5) ;SET UP STARTING LOCN INC NEST(R5)  ;NEST A LEVEL BR RPARN9   ;GO SCAN ; ; COME HERE TO EXIT AT NORMAL END OF FMT SCAN ; ENDUP: RTS PC   ;EXIT TO CALLING ROUTINE ; ; COME HERE TO CALL ERROR AND SET FLAG TO ; FLUSH I/O LIST IF ERROR RETURNS ; FIOERR: JSR R5,$ERRA  ;CALL ERROR INC ERRFLG(R4)  ;IF ERR RET'S SET FLAG JMP $IOELM   ;AND GO FLUS2  ;CHECK IF DONE ; BSP3: BITB #2,BFPTR(R2) ;INC RECORD COUNT ONLY IF LAST BNE BSP5  ;SEGMENT OF RECORD BR BSP4  ;ELSE, READ NEXT SEGMENT ; BSPY: TST (SP)+  ;CLEAR STACK MOV (SP)+,R4 ;RESET R4 CMP (SP)+,(SP)+ BR BSPX  ;GO EXIT ; BADEV: MOV #12.,R3 BSPERR: MOV #1,R0 BSPER1: SWAB R3 BIS R3,R0 JSR R5,$ERRA JSR R5,$EXIT BADRED: TST R3 BGT BSPERR CLOSER: MOV #1,R3 CLR R0 BR BSPER1 BADOPN: TST R3 BLT CLOSER ADD #3,R3 BR BSPERR ; ; sT DATA AT DISP=0 BR INRR5   ;GO READ ; ; OUTRW1: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV DVBLKN(R1),BFMODE(R2) ;SET UP BLOCK BLOCK MOV DVBLKA(R1),BFACNT(R2) MOV DVBLKL(R1),BFPTR(R2) JSR PC,$WRITE  ;WRITE TST R3 BNE INRRER   ;BRANCH IF ERRORS TST LENMAX(R5)  ;IF WAS LAST WRITE RETURN BNE OUTRW2   ;ELSE GO READ NEXT BLOCK RTS PC ; BADEV: MOV #14,R3   ;SET R3 TO BAD DEV ERR BR INRRER BADOPN: TST R3   ;CHK IF NO SPACE ERR BLT INRtOELM3: TST ERRFLG(R4) ;CHECK ERROR CONDITIONS BNE $IOELM  ;IF PRESENT FLUSH LIST RTS PC  ;OTHERWISE CONTINUE ; ; COME HERE TO DO ARRAY PROCESSING ; IOARAY: MOV (SP),R3  ;POINT TO NEXT ADB PTR ASL R3 ADD SP,R3 MOV (R3),R2 MOV (R2)+,ARGPTR(R4);SET START LOC OF ARRAY MOV (R2)+,R1 MOVB R1,ARGLEN(R4) ;SET ELGM SIZE OF ARRAY CLR R0  ;OBTAIN NUM DIMENSIONS IN R0 ROL R1  ;WD1 BITS 15-14 ROL R0 ROL R1 ROL R0 ROL R1  ;GET ARRAY TYPE RuH I/O LIST BADTAB: MOV #770.,R0   ;REF OUTSIDE RECORD BOUNDARIES BR FIOERR   ;CLASS=2/NUM=3 BADSYN: MOV #514.,R0   ;SYNTAX ERROR BR FIOERR  ;CLASS=2/NUM=2 ; ; D SPEC COMES HERE ; DSPEC: CLR CVTSW(R5)  ;SET CVT TYPE=0 EFGSP: MOV #1,R2   ;SET PROCESSING CONTROL=1 BR COMCON   ;GO PROCESS ; ; E,F,G SPECS COME HERE ; ESPEC: BR GSPEC FSPEC: BR GSPEC GSPEC: MOV #-1,CVTSW(R5)  ;SET CVT TYPE=-1 BR EFGSP   ;GO SET PROCESS CONTROL=1 ; ; I,O SPEv .TITLE RWEF01 ; ; RWDEOF V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $RWIND,$ENDFL,$IOBUF,$CLOSE,$FNDEV .GLOBL $ERRA,$EXIT .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ;THIS ROUTINE IS END FILE AND REWIND ; $RWIND: $ENDFL: MOV (SP)+,R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET DEVICE TABLE ENTRY TST R1  ;BRANCH IF ERROR BEQ BADEV ; BITB DVSW(R1),#3 ;IF FILE CLOSED, EXIT BEQ RDEFX ; MOV #$IOBUF,R2 RER   ;BR IF PRESENT ADD #3,R3   ;OTHERWISE DIDDLE R3 BR INRRER INRRER: JMP $IOERR  ;GO PROCESS THE ERROR COMPER: MOV #13,R3  ;SET COMPATABILITY ERROR BR INRRER BADREC: MOV #15,R3  ;SET INVALID RECORD BR INRRER ; ; xOL R1  ;WD1 BITS 13-11 ROL R1 ROL R1 BIC #177770,R1 ;ZERO EXTRANEOUS BITS MOV ARGLEN(R4),ARGTYP(R4) ;IF LOGICAL OR INT TYPE=LEN CMP #3,R1  ;I.E. L1=1,L2=2,I2=2 BHI IARAY0 BLO IARAY1 CMPB (R1)+,(R1)+ ;IF REAL TYPE=5 BR IARAY3 IARAY0: CMP #4,ARGLEN(R4) ;IF LOGICAL*4 OR INTEGER*4 BLT IARAY4 ASR ARGLEN(R4) ;SET LEN=2 BR IARAY4 IARAY1: CMP #4,R1 BNE IARAY2 ASL R1  ;IF DOUBLE PRECISION TYPE=8 BR IARAY3 IARAY2: INC R1  ;IF COMPLEX yCS COME HERE ; ISPEC: BR OSPEC OSPEC: MOV #1,CVTSW(R5)  ;SET CVT TYPE=1 AILOSP: CLR R2   ;SET PROCESS CONTROL=0 BR COMCON   ;GO PROCESS ; ; A SPEC COMES HERE ; ASPEC: MOV #2,CVTSW(R5)  ;SET CVT TYPE=2 BR AILOSP   ;GO SET PROCESS CONTROL=0 ; ; L SPEC COMES HERE ; LSPEC: MOV #3,CVTSW(R5)  ;SET CVT TYPE=3 BR AILOSP   ;GO SET PROCESS CONTROL=0 ; ; ; ; ALL OF A D E F G I L O COME HERE TO DO SCAN ; COMCON: ADD IOSW(R4),R0  ;SET ADDRESS OF CVT ROU;GET BUFF ADDR ; MOV DVLP(R1),BFLP(R2) ;SET LINK PTR JSR PC,$CLOSE ;CLOSE FILE TST R3 BNE CLOSER  ;BRANCH IF ERROR ; RDEFX: JMP @(R4)+  ;GO TO NEXT STMT ; BADEV: MOV #12.,R3 MOV #1,R0 RWEFER: SWAB R3 BIS R3,R0 JSR R5,$ERRA JSR R5,$EXIT CLOSER: MOV #1,R3 CLR R0 BR RWEFER ; { .TITLE DFIL01 .GLOBL $DEFIL,$FNDEV,$ERR,$EXIT .CSECT ; ; $DEFIL V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE PROCESS THE OBJECT TIME DEFINE FILE ; ; $DEFIL,ADDR FILENUM,ADDR MAX NUM RECS, ADDR OF REC LEN, ; ADDR OF ASSOC VAR ; $DEFIL: MOV @(R4)+,R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET ADDR OF DEVTB ENTRY TST R1 BEQ BADEV  ;BRANCH IF BAD DEVICE NUM ; BITB #4,D|TYPE=6 AND ASR ARGLEN(R4) ;LEN=8/2=4 IARAY3: MOV R1,ARGTYP(R4) IARAY4: MOV R4,-(SP) ;ACCUMULATE PRODUCT OF DIMENSION MOV #IARAYX+6,R4 ;SET R4 FOR POLSH CALL SUB R0,R4  ;TO $MLI SUB R0,R4 IARAY5: MOV (R2)+,-(SP) ;PUSH A DIMENSION DEC R0 BNE IARAY5  ;BRANCH IF MORE JMP @(R4)+  ;CALL $MLI IARAYX: $MLI,$MLI,IARAY6 IARAY6: MOV (SP)+,R0 ;GET PRODUCT MOV (SP)+,R4 ;RESTORE R4 IARAY7: MOV R0,-(SP) ;SAVE NUM ELEMS IN ARRAY ON STK JSR PC,@IOADDR(R4) }TINE ADD IOSW(R4),R0 MOV CONTAB-4(R0),CVTRTN(R5) ; TST INTSW(R5)  ;IF NUM PRECEEDS IT MUST BE BEQ CONV1   ;GREATER THAN ZERO BGT CONV2   ;ELSE IS ERROR CONVX: JMP BADSYN CONV1: INC INT(R5) CONV2: MOV INT(R5),REPCNT(R5) ;SAVE REP COUNT BEQ CONVX ; JSR PC,SCAN   ;GET FIELD WIDTH TST INTSW(R5)  ;MUST BE PRESENT AND GREATER BLE CONVX   ;THAN ZERO MOV INT(R5),FWIDTH(R5) ;SAVE FIELD WIDTH BEQ CONVX ; TST R2   ;IF A,I,L,O, SPEC DO ~ .TITLE OPEN01 ; ; $OPEN V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $OPEN,$RANDM .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; DO OPEN OF DEVICE - NUM IN R0, ENTRY ADDR IN R1,BUFF ; ADDR IN R2 ; SET ERROR CODES IN R3 ; $OPEN: CLR R3 TST IOTSW(R4) BGE OPNRAN  ;BRANCH IF NOT RANDOM BITB DVSW(R1),#4 ;RANDOM BEQ ERRAN  ;ERROR IF DEFINE FILE NOT DONE BR OPEN1 OPNRAN: BITB DVSW(R1),#4 ;NOT RANDOVSW(R1) ;CHECK IF DEFINE FILE DONE BEQ DEFIL1  ;BRANCH IF NOT DEFILX: ADD #6,R4  ;SKIP REST OF ARGS JMP @(R4)+  ;RETURN WITHOUT DOING DEFINE FILE ; DEFIL1: BITB #3,DVSW(R1) ;CHECK I DEVICE OPEN BNE OPNER  ;ERROR IF SO ; ; NOW SET DEFINE FILE VALUES ; MOV @(R4)+,DVRMAX(R1) ;SAVE NUM RECS IN FILE MOV @(R4)+,DVRLEN(R1) ;SAVE RECORD LEN ASL DVRLEN(R1)  ;CONVERT TO BYTES MOV (R4)+,DVAVAD(R1) ;SAVE ASSOC VAR ADDR ; BISB #4,DVSW(R1) ;SET FLAG TO INDICATE ;CALL I/O ROUTINE JSR PC,IOELM3 ;CHECK IF ERR'S REQ I/O LIST FLUSHED ADD ARGLEN(R4),ARGPTR(R4) ;POINT TO NEXT ELEM CMP #4,ARGTYP(R4) ;IF LOGICAL*4 OR INTEGER*4 BEQ IARAY9  ;IGNORE SECOND WORD CMP #6,ARGTYP(R4) ;IF WAS COMPLEX CALL I/O ROUTINE BNE IARAY8 JSR PC,@IOADDR(R4) ;WITH IMAGINARY PART JSR PC,IOELM3 ;CHECK IF ERR'S REQ I/O LIST FLUSHED IARAY9: ADD ARGLEN(R4),ARGPTR(R4) IARAY8: MOV (SP)+,R0 ;CHECK IF MORE ARRAY ELEMS DEC R0 BNE IARAY7  ;GO PROCNOT GET BEQ AILO   ;DECIMAL FIELD CMP #'.,SCNKAR(R5)  ;IF NOT . - SYNTAX ERROR BNE CONVX  JSR PC,SCAN   ;GET DECIMAL SPEC TST INTSW(R5)  ;IT MUST BE PRESENT AND NOT BLE CONVX   ;NEGATIVE MOV INT(R5),DSCALE(R5) ;SAVE DECIMAL SPEC ; AILO: JMP FMT   ;GO DO I/O FOR SPEC AND CONTINUE ; ; ADDRESS TABLE OF CONVERSION ROUTINES ; CONTAB: .WORD $ACO,$ACI .WORD $DCO,$DCI .WORD $ECO,$RCI .WORD $FCO,$RCI .WORD $GCO,$RCI .WORD 0,0 .WORD $M BNE ERNRAN  ;ERROR IF DEFINE FILE DONE ; OPEN1: MOV #OPNERI,BFLKER(R2) ;SET LNK BLK ERR RET MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 6  ;DO INIT ; MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 1  ;WAIT MOV #OPNERO,BFLKER(R2) ;RESET LNK BLK ERR RET TSTB DVHOPN(R1) ;IS CONTIGUOUS FILE TO BE ALLOC BEQ OPEN2  ;BRANCH IF NOT MOV #OPNERA,BFFLER(R2) ;SET FILBLK ERR RET MOV DVRLEN(R1),-(SP) ;GET REC LEN MOV DVRMAX(R1),-(SP) ;GET NUM RECS MOV #128.,-(SPDEFIL DONE ; JMP @(R4)+  ;RETURN ; ; BADEV: JSR R5,$ERR   ;BAD DEVICE NUM BR DEFIL2 .BYTE 1  ;CLASS=0 .BYTE 15  ;NUMBER=13 DEFIL2: BR DEFILX OPNER: JSR R5,$ERR   ;FILE OPENED NOT FOR RANDOM BR DEFIL3 .BYTE 1  ;CLASS=1 .BYTE 13  ;NUM=11 DEFIL3: JSR R5,$EXIT ; ; ESS IF ANY DEC (SP)  ;ELSE CHECK IF ANY MORE ARRAYS BNE IOARAY  ;GO PROCESS IF ANY JMP $IOELM  ;ELSE EXIT TO CALLER FOR MORE ; ICO,$ICI .WORD $LCO,$LCI .WORD $OCO,$OCI ; ; ;; ; ; COME HERE TO SET UP AND CALL ROUTINES WHICH DO ACTUAL I/O CVTS ; FMT: TST ARGPTR(R4)  ;IF ITEM LIST NOT EXHAUSTED BNE FMT1   ;GO PROCESS NEXT ITEM JMP ENDUPX   ;ELSE - GO END LAST REC AND EXIT FMT1: MOV RECPTR(R4),-(SP) ;PUSH RECORD LOC MOV FWIDTH(R5),-(SP) ;PUSH WIDTH OF FIELD ADD (SP),RECPTR(R4)  ;SET NEW RECORD LOCN CMP RECPTR(R4),RECEND(R4) ;CHECK FOR RECORD OVERFLOW BLOS FMT2   ;BRANCH IF ) ;GET NUM BYTES/BLOCK JSR PC,$RANDM ;CALC HOW MANY BLOCKS TST (SP)+ TST (SP)+  ;IF REMAINDER ADD 1 BEQ ALOC INC (SP)  ;LEAVE NUM BLOCKS ON STACK ; ALOC: MOV R2,-(SP) ;PUSH FILE BLOCK ADDR ADD #BFFLNM,(SP) MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 15  ;DO ALLOCATE ; INC (SP)+  ;TEST IF ALLOC DONE PROPERLY BNE OPNERB  ;BRANCH IF NOT ; OPEN2: MOV #OPNERR,BFFLER(R2) ;SET FILBLK ERR RET MOV R2,-(SP) ;PUSH FILE BLOCK ADDR ADD #BFFLNM,(SP) .TITLE FDEV01 ; ; $FNDEV V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $FNDEV,$DEVTB .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;; ; GET ADDR IN DEVICE TABLE OF DEVICE NUM IN R0 AND PUT ; IN R1 ; $FNDEV: TST R0  ;CHECK IF DEVICE NOT POSITIVE BLE BADEV  ;BRANCH IF SO CMP R0,$DEVTB ;CHECK IF DEVICE GT MAX NUM DEVICES BGT BADEV  ;BRANCH IF SO MOV R0,R1 ASL R1 ADD #$DEVTB+2,R1 ;GET ADDR IN VECTOR OF .TITLE $CHK01 ; ; $CHK V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $CHK,$ERR .CSECT PC=%7 SP=%6 R5=%5 R4=%4 R3=%3 R2=%2 R1=%1 R0=%0 ; ; CHECK IF POSSIBLE OVERFLOW OF STACK INTO MONITOR ; MAY OCCUR ; FLAG ERROR IF SO ; $CHK: MOV #102,-(SP) ;DO .MONF EMT EMT 41 ADD (R4)+,(SP) ;FREE SPACE = SP-MONF-POSSIBLE SUB SP,(SP)+ ;STACK USE BLE CKEX  ;IF LE 0, EXIT JSR R5,$ERR  ;CALL ERROR BR CKEX  ;POSSIBLE STACK ONOT JMP BADTAB   ;ELSE - ERROR FMT2: TST CVTSW(R5)  ;IF NOT D, E, F, OR G SPEC BGT FMTC   ;BRANCH MOV DSCALE(R5),-(SP) ;PUSH DECIMAL SCALE MOV PSCALE(R5),-(SP) ;PUSH P SCALE FMTC: TST IOSW(R4)  ;IF INPUT DO NOT SEND VALUES BNE FMTGO MOV #2,R0 TST CVTSW(R5) BEQ FMT3   ;IF D SPEC SEND 4 WORDS BLT FMT4   ;IF E, F, OR G SPEC SEND 2 WORDS CMP R0,CVTSW(R5) BHI FMT5   ;IF I OR O SPEC SEND 1 WORD BEQ $ACO   ;IF A SPEC GO DO CONVERT NOWMOV R2,-(SP) ;PUSH LINK BLOCK ADDR ; INC R3  ;ASSUME RANDOM (OPENU) TST IOTSW(R4) BGE OPEN3A  ;BRANCH IF NOT RANDOM MOV R2,-(SP) ;GET BLOCK SIZE EMT 13 CMP (SP)+,(SP)+ MOV (SP),DVBLKL(R1)  ;SAVE NUM BYTES IN BLOCK ADD (SP)+,DVBLKL(R1) MOV #-1,DVBLKN(R1) BR OPEN3 OPEN3A: ASL R3  ;ASSUME OUTPUT (OPENO) TST IOSW(R4) BEQ OPEN3  ;BRANCH IF OUTPUT ASL R3  ;SET OPENI OPEN3: MOVB R3,BFHOPN(R2) EMT 16  ;DO OPEN ; ; MOV R2,-(SP) TABLE ENTRY TST (R1)  ;DOES ENTRY EXIST BEQ BADEV  ;BRANCH IF NOT MOV (R1),R1  ;SET ADDRESS OF DEVICE TABLE ENTRY RTS PC  ;RETURN ; BADEV: CLR R1  ;SET BAD DEVICE CODE RTS PC ; ; .END VERFLOW .WORD 0  ;ASSIGN ERROR CLASS/NUM??? CKEX: JMP @(R4)+  ;EXIT ; ; .END MOVB @ARGPTR(R4),R0  ;IF L SPEC SEND 1 BYTE TWICE MOV R0,-(SP) BR FMTGO FMT3: ASL R0 FMT4: ASL R0 FMT5: MOV ARGPTR(R4),R1 ;PUSH REQUIRED NUM WORDS 1 BYTE ADD R0,R1 ASR R0   ;AT A TIME ONTO THE STACK FMT6: TST -(SP) MOVB -(R1),1(SP) MOVB -(R1),(SP) DEC R0 BNE FMT6 FMTGO: JSR PC,@CVTRTN(R5)  ;GO DO CONVERT ROR R3   ;SAVE ERROR STATUS FMT7: TST IOSW(R4)  ;IF OUTPUT DO NOT RETRIEVE VALUE BEQ FMTX   ;BRANCH IF OUTPUT MOV #2,R0 ;PUSH LINK BLOCK ADDR EMT 1  ;WAIT ; ; ; MOVB BFHOPN(R2),DVHOPN(R1) ;SAVE HOW OPEN MOV IOTSW(R4),R3 ;SET OPEN SWITCH BGE OPEN4 MOV #2,R3 OPEN4: INC R3 BISB R3,DVSW(R1) MOV BFLP(R2),DVLP(R1) CLR R3  ;SET NO ERRORS RTS PC  ;RETURN ; ; ; ERRAN: MOV #3,R3  ;SET DEFINE FILE NOT DONE ERR RTS PC ; ERNRAN: MOV #4,R3  ;SET NONRAN OPEN/DEFINE FILE DONE RTS PC ; OPNERI: MOV #-1,R3  ;NO SPACE TO INIT ERROR RTS PC OPNERO: MOV #-1,R3 .TITLE STOP02 .GLOBL $STOP,$EXIT .CSECT ; ; $STOP V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 R5=%5 SP=%6 ; ; THIS IS THE OBJECT TIME STOP ROUTINE ; IT WILL CAUSE A MONITOR DIAG PRINT(INFORMATIONAL) ; WITH NUM INDICATED ; $STOP: MOV R4,-(SP) ;PUSH ADDR OF STOP NUM MOV #4,-(SP) ;PUSH .O2BIN CONVT CODE EMT 42  ;DO CONVERSION ; MOV DIAG,-(SP) ;PUSH DIAG TYPE IOT   ;DO DIAGNOSE ; JSR R5,$EXIT ;EXIT TO MONITOR ; .TITLE PAUS01 .GLOBL $PAUSE .CSECT ; ; $PAUSE V001A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 SP=%6 ; THIS IS THE OBJECT TIME PAUSE ROUTINE ; IT WILL CAUSE A MONITOR DIAGNOSTIC PRINT(ACTION READ) ; WITH NUM INDICATED ; $PAUSE: MOV R4,-(SP) ;PUSH ADDR OF PAUSE NUM MOV #4,-(SP) ;PUSH .O2BIN CONVT CODE EMT 42  ;DO CONVERSION ; MOV DIAG,-(SP) ;PUSH DIAG TYPE IOT   ;DO DIAGNOSE ; ; IF CONTINUE ; MOV (SP)+,R4 ;POP ADDR TST CVTSW(R5) BEQ FMT8   ;IF DSPEC GET 4 WORDS BLT FMT9   ;IF E, F, OR G SPEC GET 2 WORDS CMP R0,CVTSW(R5) BHI FMTA   ;IF I OR O SPEC GET 1 WORD CMP R0,ARGLEN(R4)  ;IF L SPEC MOVE 1 BYTE OR 1 WORD BLOS FMTA   ;DEPENDING ON STORAGE WIDTH OF MOVB (SP)+,@ARGPTR(R4) ;ARG BR FMTX ; FMT8: ASL R0 FMT9: ASL R0 FMTA: MOV ARGPTR(R4),R1  ;POP REQUIRED NUM WORDS 1 BYTE MOV SP,R2   ;AT A TIME FROM THE STACK FMTB: MOVB (R2)+,(R1)+ DEC R0 BN ;NO SPACE TO OPEN ERROR OPNER: MOV R2,-(SP) ;PUSH LINK BLOCK ADDR MOV #OPNERI,BFLKER(R2) ;SET LNK BLK ERR RTN EMT 7  ;DO RLSE RTS PC ; OPNERA: TST (SP)+  ;REMOVE WORD FROM STACK OPNERB: MOV #2,R3  ;UNABLE TO ALLOC CONTIG FILE BR OPNER  ;GO RLSE AND RETURN ; OPNERR: CMPB #2,BFHOPN(R2) ;CHECK IF WAS OPENO. BNE OPNER1  ;BRANCH IF NOT ; CMPB #2,BFSTAT(R2) ;CHECK IF FILE ALREADY EXISTS BNE OPNER1  ;BRANCH IF NOT MOV #13,R3  ;TRY AGAIN OPENC ; DIAG: .BYTE 350  ;NUM OF DIAG .BYTE 0  ;INDICATE INFORMATIONAL MSG ; .END OF FAILURE BIT #1,R4  ;CHECK IF EVEN OR ODD BNE PAU01  ;AND SET R4 TO NEXT WORD INC R4 PAU01: INC R4 ; JMP @(R4)+  ;RETURN TO CALLER ; DIAG: .BYTE 5  ;NUM OF DIAG .BYTE 1  ;INDICATE ACTION REQUIRED MSG ; .END E FMTB MOV R2,SP FMTX: ROL R3   ;BRANCH IF CVT ERR OFF BCC FMTRET MOV #6.,R0  ;ELSE - CVT ERR JSR R5,$ERRA  ;CALL ERROR    ;CLASS=6/NUM=0    ;IF ERROR RETURNS CONTINUE FMTRET: RTS PC   ;RETURN TO GET NEXT ARG OR END REENT: DEC REPCNT(R5)  ;REENTER HERE BNE FMT   ;IF MORE REPCNT FO CVT CLR EXITSW(R5)  ;ELSE - SET CVT DONE SWITCH CLR INTSW(R5)  ;RESET ACCUMULATOR AND STATUS CLR INT(R5) JMP FCONT   ;ALLOW T/),'SPECS ONLY ; ; ;BR OPEN3 ; OPNER1: MOV #5,R3 CMPB #6,BFSTAT(R2) ;CHECK PROTECT CODE ERROR BEQ OPNER  ;BRANCH IF SO INC R3 CMPB #1,BFSTAT(R2) ;CHECK ALREADY. OPEN/DOES NOT EXIST BEQ OPNER2  ;BRANCH IF NOT CMPB #5,BFSTAT(R2) BHI OPNER OPNER2: INC R3  ;DEFAULT-UNABLE TO OPEN ERROR BR OPNER ; ; ERROR RETURNS IN R3 ; -1=NO SPACE TO DO I/O ; 2=UNABLE TO ALLOC CONTIG FILE ; 3=DEFINE FILE NOT DONE (RANDOM) ; 4=DEFINE FILE DONE (NOT RANDOM) ; 5=INVALID PROTECT CODE ; .TITLE FIND01 ; ; $FIND V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $FIND .CSECT R4=%4 SP=%6 ; ; THIS IS THE OBJECT TIME FIND ROUTINE FOR RANDOM I/O ; IT DOES NOTHING BUT RETURN ; ; $FIND,ADDR OF END RETURN, ADDR OF ERR RETURN ; $FIND: CMP (SP)+,(SP)+ ;REMOVE RECORD AND UNIT NUMBER CMP (R4)+,(R4)+ ;STEP OVER ARGS JMP @(R4)+  ;RETURN ; .END .TITLE RNDM02 ; ; $RANDM V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $RANDM .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; DO BLOCK/DISP CALC FOR RANDOM I/O ; A3=12. A1=16. A2=14. $RANDM: MOV R0,-(SP) ;SAVE REGS MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV A1(SP),R3 ;GET ARGS TO MULTIPLY MOV A2(SP),R4 ;R4*(R2,R3)=(R0,R1) CLR R0 CLR R2 CLR R1 RANDM1: CLC ;MULTIPLY AN COME HERE TO DO OUTPUT A CONVERSION ; $ACO: MOV ARGPTR(R4),R1  ;GET PTR TO FIRST CHAR OF ITEM MOV (SP)+,R2  ;GET FIELD WIDTH MOV (SP)+,R0  ;GET PTR TO FIRST CHAR OF REC MOV ARGLEN(R4),R3  ;GET ITEM WIDTH CMP R3,R2  ;BRANCH IF FIELD WIDTH WIDER THAN ITEM TO BHIS OCA1  ;MOVE INIT SEG OF ITEM ;ELSE LEAVE LEADING BLANKS AND MOVE ITEM WIDTH CHARS ADD R2,R0 SUB R3,R0 MOV R3,R2 OCA1: MOVB (R1)+,(R0)+  ;MOVE CHARS FROM ITEM TO REC DEC R2 BNE OCA1 6=FILE DOES NOT EXIST/OR ALREADY OPEN ; 7=UNABLE TO OPEN ; ; .TITLE WRIT01 ; ; $WRITE V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $WRITE .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; WRITE A RECORD (R1=DEVTAB ENTRY, R2=BUFF ADDR, R0= DEV NUM) ; R3=ERROR RETURNS ; $WRITE: MOV #WRITER,BFLKER(R2) TST IOTSW(R4) BLT WRITR  ;BRANCH IF RANDOM WRITE BNE WRITU  ;BRANCH IF UNFMTD CLRB BFMODE(R2) ;SET FMTD, ASCII, NODUMP, NO PARITY, BR WRITF  ;NORMAL MODE WRITU: D LEAVE DP RESULT ROR R4 ;IN R0 AND R1 BCC RANDM2 ADD R3,R1 ADC R0 ADD R2,R0 RANDM2: ASL R3 ROL R2 TST R4 BNE RANDM1 CLR R4 ;NOW DIVIDE BY 3RD ARG CLR R2 ;LEAVE QUOTIENT IN R1, REMAINDER MOV A3(SP),R3 ;IN R0 RANDM3: ASR R3 BEQ RANDM5 ASR R0 ROR R1 ROR R2 INC R4 BR RANDM3 ; RANDM5: CLR R0 RANDM4: ASL R2 ;MOVE REMAINDER FROM HIGH END OF ROL R0 ;R2 TO LOW END R0 DEC R4 BNE RANDM4 MOV R1,A1(SP) ;RCLR R3   ;SET CVT ERR OFF JMP FMTX   ;GO BACK TO CALLER ; ; COME HERE TO DO INPUT A CONVERSION ; $ACI: TST (SP)+   ;REMOVE RETURN FROM STACK MOV (SP)+,R2   MOV (SP)+,R1  ;GET PTR TO FIRST CHAR MOV ARGPTR(R4),R0  ;GET PTR TO FIRST CHAR OF ITEM MOV ARGLEN(R4),R3  ;GET ITEM WIDTH CMP R3,R2  ;IF FIELD WIDTH = ARG LEN BEQ OCA1   ;GO MOVE FIELD WIDTH CHARS BHI ICA2 ADD R2,R1 SUB R3,R1 MOV R3,R2 BR OCA1 ICA2: ADD R3,R0 SUB R2,R .TITLE READ01 ; ; $READ V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $READ .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; READ A RECORD-R1=DEVTAB ENTRY, R2=BUFF ADDR, R0=DEV NUM ; R3=ERROR RETURNS $READ: MOV #READER,BFLKER(R2) ;SET LNK BLK ERR RTN TST IOTSW(R4) ;CHECK WHICH TYPE INPUT BLT READR  ;BRANCH IF RANDOM BNE READU  ;BRANCH IF UNFMTD CLRB BFMODE(R2) ;SET ASCII FMTD, NODUMP, NO PARITY, BR RMOVB #1,BFMODE(R2) ;SET FMTD, BINARY, NODUMP, ;    ;PARITY, NORMAL MODE ; DO FMTD/UNFMTD WRITE ; WRITF: MOV R2,-(SP) ;PUSH BUFF HEADER ADDR ADD #BFMCNT,(SP) MOV R2,-(SP) ;PUSH BLINK BLOCK ADDR EMT 2  ;WRITE ; MOV R2,-(SP) EMT 1  ;WAIT ; ; CHECK ERRORS ; CLR R3 ; ; ERROR VALUES ; ; 1=DEVICE PARITY ; 2=END OF DATA ERROR? (RANDOM ONLY) ; 3=UNDIAGNOSABLE ERROR ; 4=EOF/EOM ; ; -1=OUT OF SPACE ; ; TSTB BFSTAT(R2) BEQ WRITX  ;BRANCH IF ETURN QUOTIENT MOV R0,A2(SP) ;RETURN REMAINDER MOV (SP)+,R4 ;RESTORE REGS MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ;EXIT ; ; .END 3 ICA3: MOVB #' ,-(R0) DEC R3 BNE ICA3 SUB R2,R0 BR OCA1 ; ; EADF  ;NORMAL MODE READU: MOVB #1,BFMODE(R2) ;SET BINARY, FMTD, NODUMP, ;    PARITY, NORMAL MODE ; DO FMTD/UNFMTD READ READF: MOV R2,-(SP) ;PUSH ADDR BUFF HEADER ADD #BFMCNT,(SP) MOV R2,-(SP) ;PUSH ADDR LINK BLOCK EMT 4 MOV R2,-(SP) EMT 1  ;WAIT ; ; CHECK ERRORS ; CLR R3 TST BFACNT(R2) ;BRANCH IF BYTES TRANSMITTED BNE RERR1 BITB #100,BFSTAT(R2) ;ELSE - TEST IF EOF BEQ RERR2  ;BRANCH IF NOT MOV #4,R3  ;SET EOF RETURN BR READXNO ERRS INC R3 BITB #40,BFSTAT(R2) ;BRANCH IF DEVICE PARITY BNE WRITX INC R3 INC R3 BITB #100,BFSTAT(R2) ;BRANCH IF UNDIAGNOSABLE BEQ WRITX INC R3  ;SET EOF/EOM WRITX: RTS PC  ;EXIT ; ; WRITER: MOV #-1,R3  ;SET OUT OF SPACE ERROR RTS PC  ;RETURN ; ; RANDOM WRITE COMES HERE ; ; WRITR: MOV #2,BFMCNT(R2) ;SET FNCN WRD TO WRITE MOV R2,-(SP) ;PUSH BLOCK BLOCK ADDR ADD #BFMCNT,(SP) ; MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 11  .TITLE CLSE01 ; ; $CLOSE V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $CLOSE .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; CLOSE AND RLSE A DATASET ; R0=DEVICE NUM ; R1=DEVICE TABLE ENTRY PTR ; R2=BUFF PTR ; R3=ERROR RETURN CODES (0=NONE, -1=OUT OF SPACE) ; $CLOSE: MOV #CLOSER,BFLKER(R2) ;SET LNK BLK ERR RTN MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 17  ;CLOSE ; MOV R2,-(SP) EMT 1  ;WAIT MOV .TITLE SFIL01 .GLOBL SETFIL,$DEVTB .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; SETFIL V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; THIS ROUTINE PROVIDES A MEANS BY WHICH THE USER MAY ; OVERRIDE THE DEVICE TABLE DEFAULTS FOR A FORTRAN DEVICE ; ; CALLING SEQUENCE ; ; JSR R5,SETFIL ; BR NEXT ; ADDR OF LOG DEVICE NUM(INTEGER) ; ADDR OF FILE NAME(ASCII STRING) ; ADDR OF ERROR VALUE VAR(INTEGER) ; ADDR OF PHYSICAL DEVIC  ;EXIT RERR1: BICB #331,BFSTAT(R2) ;CLEAR NON-ACTIVE, EOF AND SHORT BEQ READX  ;REC BITS FROM STATUS-BR IF NO ERR RERR2: INC R3 BITB #40,BFSTAT(R2) ;CHECK IF DEVICE PARITY BNE READX  ;BRANCH IF SO INC R3 BITB #6,BFSTAT(R2) ;CHECK IF CHECKSUM/PARITY ERROR BNE READX  ;BRANCH IF SO INC R3  ;SET UNDIAGNOSABLE READ ERROR ; READX: RTS PC  ;RETURN ; ; ERROR RETURN VALUES ; 1=DEVICE PARITY ; 2=CHECKSUM/PARITY ERR OR END OF DATA ERROR?(RANDOM) ; 3=UNDI ;WRITE MOV R2,-(SP) EMT 1  ;WAIT ; CLR R3 TSTB BFMCNT+1(R2) ;BRANCH IF NO ERRORS BEQ WRITX INC R3 BITB #200,BFMCNT+1(R2) ;BRANCH IF DEVICE PARITY BNE WRITX INC R3 BITB #100,BFMCNT+1(R2) ;BRANCH IF END OF DATA ERROR BNE WRITX INC R3 BITB #10,BFMCNT+1(R2) ;BRANCH IF UNDIAGNOSABLE BEQ WRITX INC R3 ;SET EOF/EOM ERROR BR WRITX ; ; R2,-(SP) EMT 7  ;RLSE ; CLRB DVHOPN(R1) ;CLEAR HOW OPEN FLAG BICB #3,DVSW(R1) ;SET DEVICE CLOSED SWITCHES CLR DVFWRD(R1) ;CLEAR - STATUS/MODE, I/0 COUNT CLR DVBLKN(R1) ;FOR FMTD/UNFMTD I/O CLR DVBLKA(R1) ;FUNC WRD,BLKNUM,BUFF ADDR, BUFF LEN CLR DVBLKL(R1) ;FOR RANDOM I/O CLR DVLP(R1) ;CLEAR LINK PTR CLR R3  ;SET NO ERRORS RTS PC  ;RETURN ; CLOSER: MOV #-1,R3 ;SET OUT OF SPACE ERROR RTS PC ;RETURN ; ; E NAME(3 CHAR ASCII) ; ADDR OF UNIT NUM(INTEGER) ; ADDR OF UIC (INTEGER) ; ADDR OF PROTECT CODE(INTEGER) ; ADDR OF ALLOCATE FILE VALUE(INTEGER) ; ADDR OF RECORD LEN TO ALLOC(INTEGER) ; ADDR OF NUM RECS TO ALLOC(INTEGER) ;NEXT= . ; SETFIL: MOV R5,-(SP) ;SAVE REGS MOV R4,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV #$DEVTB,R4 ;GET ADDR OF DEVICE TABLE MOVB (R5)+,R3 ;GET NUM ARGS IN CALL BEQ EXFIL  ;EXIT IF NO ARGS TSTB (R5)+  ;MAKAGNOSABLE ERROR ; 4=EOF/EOM ; ; -1=OUT OF SPACE ; READER: MOV #-1,R3  ;SET OUT OF SPACE ERROR RTS PC ; ; ; RANDOM READ COMES HERE ; READR: MOV #4,BFMCNT(R2) ;SET FUNCN WRD TO READ MOV R2,-(SP) ;PUSH BLOCK BLOCK ADDR ADD #BFMCNT,(SP) MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 11  ;READ MOV R2,-(SP) EMT 1  ;WAIT ; CLR R3 TSTB BFMCNT+1(R2) ;TEST FOR ERROR5 BEQ READX  ;BRANCH IF NONE INC R3 BITB #200,BFMCNT+1(R2) ;BRANCH IF DEVICE PAR .TITLE SERR01 ; ; SETERR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL SETERR,$ERRC .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; CALL SETERR (ERR CLASS, LOG LIMIT VALUE) ; SETERR: MOV R5,-(SP) MOV R4,-(SP) MOV R3,-(SP) CMPB #2,(R5) BNE EREX  ;IF NOT 2 ARGS EXIT TST (R5)+ MOV @(R5)+,R4 ;GET CLASS NUM BLE EREX MOV @(R5),R3 ;GET MAX LOG VALUE MOV #$ERRC,R5 CMP R4,-2(R5) ;CHECK IF VALID .TITLE $NAM01 .GLOBL $NAM,$NAMC,$SEQC,$RET,$ERRA .CSECT ; ; $NAM V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 R5=%5 R0=%0 ; ; CHAIN SUBROUTINE NAMES TOGETHER AND SAVE ; END OF CHAIN PTR ; $NAM: MOV $NAMC,R0 ;ADDR LAST ENTRY IN CHAIN MOV R4,$NAMC ;SET ADDR THIS ENTRY AS LAST TST @R4 ;IS SUBROUTINE ATTEMPTING TO REF ITSELF? BNE NAMERR  ;BRANCH IF SO MOV R0,(R4)+ ;CHAIN ENTRIES MOV $SEQC,(R4)+ ;SET SEQ NUM OF CALLING SE R5 EVEN!!!! CMP (R4),@(R5) ;CHECK IF VALID DEVICE NUM BLO EXFIL  ;EXIT IF NOT ADD @(R5),R4 ADD @(R5)+,R4 MOV 2(R4),R4 ;ADDR OF DEVTB ENTRY FOR DEVICE DEC R3 BEQ EXFIL  ;EXIT IF NO MORE ARGS BITB #3,DVSW(R4) ;CHECK IF FILE OPEN BNE EXFIL  ;EXIT IF OPEN MOV (R5)+,R1 ;GET ADDR OF FILE NAME AND EXT ; MOV #" ,-(SP) MOV #" ,-(SP) MOV #" ,-(SP) MOV SP,R2 MOV #6.,R0 FNAME1: CMPB #'.,(R1) BEQ FNAME2 MOVB (R1)+,(R2)+ DEC R0ITY BNE READX INC R3 BITB #100,BFMCNT+1(R2) ;BRANCH IF END OF DATA ERROR BNE READX INC R3 BITB #10,BFMCNT+1(R2) ;BRANCH IF UNDIAGNOSABLE BEQ READX INC R3 ;SET EOF ERROR BR READX ; ; CLASS BHI EREX  ;EXIT IF NOT ADD R4,R5 ADD R4,R5 MOV R3,4(R5) ;SET NEW VALUE EREX: MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RTS R5  ;EXIT ; ; .END TMT CMP (R4)+,(R4)+ ;STEP OVER ROUTINE NAME JMP @(R4)+  ;RETURN ; ; UNDO SUBROUTINE CHAIN ; $RET: MOV $NAMC,R4 ;GET ADDR OF LAST ENTRY IN CHAIN MOV (R4),$NAMC ;REMOVE FROM CHAIN CLR (R4)+  ;CLEAR CHAIN PTR CLR (R4)+  ;AND CALLING STMT NUM RTS R5  ;RETURN ; ; NAMERR: MOV #512.,R0 ;CALL ERROR CLASS=0/NUM=2 JSR R5,$ERRA .END BNE FNAME1 FNAME2: CMPB #'.,(R1)+ BNE FNAME3 MOV R1,R2 JSR PC,RAD  ;CVT FILE EXT TO RAD50 MOV (SP)+,DVFLNM+4(R4) ;SET FILE EXT ; FNAME3: MOV SP,R2 JSR PC,RAD MOV (SP)+,DVFLNM(R4) ;SET FILE NAME ADD #3,R2 JSR PC,RAD MOV (SP)+,DVFLNM+2(R4) ADD #6,SP FNAME4: DEC R3 BEQ EXFIL MOV (R5),DVARAD(R4) ;SET ADDR OF ERROR VAR CLR @(R5)+ DEC R3 BEQ EXFIL MOV (R5)+,R2 ;GET PHYSICAL DEVICE NAME JSR PC,RAD MOV (SP)+,DVPDVN(R4) .TITLE $SEQ01 ; ; $SEQ V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $SEQ,$SEQC .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; SAVE SEQUENCE NUM OF CURRENT FORTRAN STMT ; ; $SEQ: MOV (R4)+,$SEQC ;SAVE NUM JMP @(R4)+  ;EXIT ; ; .END .TITLE DLCO01 ; ; $DLCO V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $LCO,$ERRA R0=%0 R5=%5 .CSECT $LCO: CLR R0 JSR R5,$ERRA .END .TITLE DICO01 ; ; $DICO V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $ICO,$OCO,$ERRA R0=%0 R5=%5 .CSECT $ICO: $OCO: CLR R0 JSR R5,$ERRA .END DEC R3 BEQ EXFIL MOVB @(R5),DVUNUM(R4) ;GET UNIT NUM TST (R5)+ DEC R3 BEQ EXFIL MOV @(R5)+,DVUIC(R4) ;GET UIC DEC R3 BEQ EXFIL MOVB @(R5),DVPC(R4) ;GET PROTECT CODE TST (R5)+ DEC R3 BEQ EXFIL CMP @(R5),#2 ;CHECK IF RANDOM ALLOCATE BEQ RANAL  ;BRANCH IF RANDOM (DEFN FILE SETS) CMP @(R5)+,#1 ;CHECK IF NON-RANDOM ALLOCATE BNE SFERR  ;ERROR IF NOT CMP R3,#2  ;MUST BE 2 MORE ARGS BNE SFERR  ;ERROR IF NOT MOV @(R5)+,DV .TITLE DDCO01 ; ; $DDCO V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $DCO,$ECO,$FCO,$GCO,$ERRA R0=%0 R5=%5 .CSECT $DCO: $ECO: $FCO: $GCO: CLR R0 JSR R5,$ERRA .END .TITLE DICI01 ; ; $DICI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $ICI,$OCI,$ERRA R0=%0 R5=%5 .CSECT $ICI: $OCI: CLR R0 JSR R5,$ERRA .END .TITLE DLCI01 ; ; $DLCI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $LCI,$ERRA R0=%0 R5=%5 .CSECT $LCI: CLR R0 JSR R5,$ERRA .END RLEN(R4) ;SET RECLEN MOV @(R5)+,DVRMAX(R4) ;SENUM RECS TO ALLOC BR EXFIL RANAL: MOV #127.,DVHOPN(R4) ;SET FLAG TO INDICATE ALLOC REQD EXFIL: MOV (SP)+,R0 ;RESTORE REGS MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RTS R5  ;EXIT ; SFERR: MOV #-1,@DVARAD(R4) ;SET INVALID ARGS ERROR BR EXFIL  ;EXIT ; ; RAD: MOV R2,-(SP) CLR -(SP) EMT 42 MOV 4(SP),2(SP) MOV (SP)+,2(SP) RTS PC ; ; .TITLE DDCI01 ; ; $DDCI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $DCI,$RCI,$ERRA R0=%0 R5=%5 .CSECT $DCI: $RCI: CLR R0 JSR R5,$ERRA .END .TITLE $ERR05 .GLOBL $ERR,$ERRA,$ERRC,$EXIT,$RTS,$EXSW,$IOBUF,$ERRWK .GLOBL $DEVTB,$IOSET,$TRCBK .CSECT ; ; $ERR V005A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS IS THE OBJECT TIME FORTRAN ERROR HANDLER ; ; CALLING SEQUENCE- ; ; JSR R5,$ERR ; BR NEXT ; .BYTE ERROR CLASS ; .BYTE ERROR NUMBER ; ; OR ; MOV #ERRNUM*256.+ERRCLASS,R0 ; JSR R5,$ERRA ; $ERR: MOV R0,-(SP) ;S .TITLE $TRC02 .GLOBL $TRCBK,$NAMC,$SEQC .CSECT ; ; $TRCBK V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO GENERATE SUBROUTINE TRACEBACK ; AND REG DUMP (FMTD ASCII OUTPUT) ; SP = ADDR OF R5,R4,R3,R2,R1,R0 TO BE DUMPED ; R0 = SAVED ; R1 = SAVED ; R2 = ADDR OF DDB PTR FOLLOWED BY 4 WD LINE BUF HDR ; R3 = SET TO 1 IF EOF ON DEVICE, ELSE CLEARED ; R4 = SAVED ; R5 = ADD .TITLE OTSV01 ; ; $OTSV V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $OTSV .GLOBL $IOBUF,$DEVTB,$ERRC .GLOBL $NAMC,$SEQC,$EXSW,$ERRWK .CSECT ; ; ; THIS IS AN OTS NON-REEENTRANT AREA ; ; $OTSV: .WORD $DEVTB .WORD $IOBUF .WORD $ERRC ; $NAMC: .WORD 0 ;ADDR OF END OF SUBR TRCBK CHAIN ; $SEQC: .WORD 0 ;VALUE OF CURRENT INTERNAL SEQ ;NUMBER ; $EXSW: .WORD 0 ;VALUE FOR EXIT ROUTINE: ;0=USER CALL ;1=ERRORS HAVE OCCURED THIS RUN .TITLE ERRC04 .GLOBL $ERRC,$RTS,$EXIT .CSECT ; ; $ERRC V004A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; THIS IS THE FORTRN ERROR CLASS TABLE ; .WORD 6.  ;NUMBER OF LAST CLASS IN TABLE ; ; CLASS 0 ENTRY ; $ERRC: .BYTE 2.  ;NUM MSGS IN THIS CLASS .BYTE 0  ;REC NUM OF 1ST MSG OF CLASS    ;IN MSG FILE .WORD $RTS  ;TRANSFER ADDRESS .WORD -3  ;MAX ALLOWED OCCURANCE COUNT    ;POS=LOG, INC COUNT CALL EXIT    ;IF MATCHAVE R0 MOV 2(R5),R0 ;GET ERR CLASS/NUM BR ERRB ; $ERRA: MOV R0,-(SP) ;SAVE R0 (CONTAINS ERR CLASS/NUM) ERRB: MOV R1,-(SP) ;SAVE R1-R5 MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) ; ; GET ERROR CLASS TABLE ENTRY INTO R4 ; PUT ERROR CLASS IN R3 ; ERRC: MOVB R0,R3 BLT BADERR  ;BRANCH IS CLASS<0 MOV #$ERRC,R4 CMP R3,-2(R4) BLOS GETENT  ;BRANCH IF VALID CLASS BADERR: CLR R0  ;ELSE SET CLASS/NUM =0 BR ERRC GETENT: ASL R3 ASL R OF AREA TO AVILD REC ; JSR PC,$TRCBK ; ; $TRCBK: MOV R0,-(SP) MOV SP,R0 ADD #4,R0 MOV R0,-(SP) MOV 2(SP),R0 MOV (SP)+,(SP) MOV R0,-(SP) MOV R1,-(SP) MOV R4,-(SP) ; ; FIRST GENERATE REGISTER DUMP ; MOV #5015,(R5) ;PUT CR, LF IN BUF MOV #2,R0  ;SEND LENGTH JSR PC,WRIT  ;WRITE SPACE LINE ; ; ; TO PROVIDE REGISTER DUMP SET REGSW=1 ; REGSW=0 ; .IFNZ REGSW ; REGS: MOV #5015,24.(R5) ;PUT CR LF AT END OF LINE MOV #24.,R0 MOV ;2=AN ERR HAS REACHED ITS MAX ;ALLOWED COUNT ;3=AN ERR WHOSE MAX ALLOWED ;IS -2 HAS CALLED EXIT ; $ERRWK: .=.+26. ;13 WORDS OF WORK AREA ;FOR ERROR ROUTINE (USED ;ONLY IF MSG FILE NOT ;AVAILABLE) ; .END    ;0=LOG AND IGNORE    ;-1=IGNORE ERROR (NO LOG)    ;-2=EXIT WITHOUT LOGGING    ;-3=IMMEDIATE RUN ABORT .WORD 0  ;ACTUAL COUNT ; ; CLASS 1 ENTRY ; .BYTE 15. .BYTE 2 .WORD $RTS .WORD 0  ; LOG AND IGNORE .WORD 0 ; ; CLASS 2 ENTRY ; .BYTE 3. .BYTE 9. .WORD $RTS .WORD 1  ;LOG, INC COUNT CALL EXIT .WORD 0  ;IF MATCH ; ; ; CLASS 3 ENTRY ; .BYTE 23. .BYTE 11. .WORD $RTS .WORD 3  ;LOG, INC COUNT CALL EXIT R3 ASL R3 ADD R3,R4  ;ADDR OF CLASS ENTRY IN R4 SWAB R0 MOVB R0,R3  ;ERR NUM IN R3 BLT BADERR  ;BRANCH IF NUM<0 CMPB R3,(R4) BGT BADERR  ;BRANCH IF INVALID NUM ; ; PROCESS ERROR DEPENDING ON LOG LIMIT ; ; -3=ABORT RUN ; -2=CALL EXIT (NO LOG) ; -1=NO LOG AND IGNORE ; 0=LOG AND IGNORE ; >0=LOG, ING COUNT CALL EXIT IF MATCH ; ; CMP #-1,4(R4) BEQ ERRX  ;BRANCH IF ERR TO BE IGNORED BLT LOG  ;BRANCH IF MSG TO BE LOGGED CMP #-2,4(R4) BN R5,R1 REGS1: MOVB #' ,(R1)+ ;BLANK LINE DEC R0 BNE REGS1 ; MOVB #'=,3(R5) ;PUT IN 2 = AND A TAB MOVB #'=,15.(R5) MOVB #11,11.(R5) MOV #26.,R0  ;SET REC LEN MOV SP,R4  ;ADDR VALUES TO BE OUTPUT ADD #22.,R4 MOV #4.,R1  ;8 REGS MOV #RNMS,R3 ;NAME OF REGS ; REGS2: MOV (R3)+,(R5) ;PUT 2 REG NAMES INTO REC MOV (R3)+,12.(R5) MOV -(R4),-(SP) ;PUT 1ST VALUE ON STACK MOV R5,-(SP) ;PUT REC LOC OF RESULT ADD #5,(SP) MOV #5,-(SP) EM .TITLE EXIT02 .GLOBL EXIT,$EXSW,$EXIT .CSECT ; ; $EXIT V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS IS THE OBJECT TIME EXIT ROUTINE ; ; $EXIT: EXIT: MOV $EXSW,R0 BNE EXIT1  ;BRANCH IF WERE ERRORS END: EMT 60  ;EXIT TO MONITOR ; EXIT1: DEC R0 BEQ END  ;IF MSGS LOGGED EXIT MOV R0,-(SP) ;NOTE ERROR MAX CNT REACHED OR MOV EXNOTE,-(SP) ;NOTE LOGGING ERROR CALLED .WORD 0  ;IF MATCH ; ; CLASS 4 ENTRY ; .BYTE 15. .BYTE 23. .WORD $RTS .WORD 4  ;LOG, INC COUNT CALL EXIT .WORD 0  ;IF MATCH ; ; CLASS 5 ENTRY ; .BYTE 8. .BYTE 31. .WORD $RTS .WORD -1  ;IGNORE ERROR (NO LOG) .WORD 0 ; ; CLASS 6 ENTRY ; .BYTE 0 .BYTE 36. .WORD $RTS .WORD 0  ;LOG AND IGNORE .WORD 0 ; .END E ABORT  ;BRANCH TO IMMEDIATE ABORT MOV #3,$EXSW ;SET ERROR INDICATOR FOR EXIT ERRXIT: MOV #$EXIT,2(R4) ;SET TRANS VEC TO CALL EXIT BR ERRX  ;GO EXIT ABORT: JSR PC,$TRCBK ;LEAVE A TRAIL SUB R3,R0 ASL R0 ADD R3,R0  ;ERR NUM FOR PRINT, FORCE TO LOOK LIKE MOV R0,-(SP) ;3 CHAR CLASS + 3 CHAR NUM MOV ABCD,-(SP) ;INDICATE FATAL FORTRAN ERROR IOT   ;EXIT TO MONITOR ABCD: .BYTE 30  ;GET NUM FROM H. SHEPARDSON .BYTE 3  ;INDICATE FATAL ERROR ; ERRX: T 42  ;CONVERT TO OCTAL INTO REC MOV -(R4),-(SP) ;PUT 2ND VALUE ON STACK MOV R5,-(SP) ;PUT REC LOC OF RESULT ADD #17.,(SP) MOV #5,-(SP) EMT 42  ;CONVERT TO OCTAL JSR PC,WRIT  ;WRITE LINE DEC R1 BNE REGS2  ;BRANCH IS R0-R5,PC AND SP NOT DONE ; .ENDC ; ; NOW DO NAME/SEQ TRACE IF AVAILABLE ; TST $NAMC  ;IF NO NAME CHAIN EXIT BEQ ENDTRC  ;TO CALLER MOV R5,R1 MOV #14.,R0 TBK: MOVB #' ,(R1)+ ;CLEAR BUFF DEC R0 BNE TBK MOV #5EXIT IOT BR END ; EXNOTE: .BYTE 351  ;NUM OF DIAG .BYTE 0  ;INFORM OF ABNORMAL EXIT CONDITION .END .TITLE ISET03 .GLOBL $IOSET .CSECT ; ; $IOSET V003A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE SETS UP I/O BUFFER FOR OPENS ; ; R0=DEVICE NUM. R1=DEVTAB ENTRY, R2=BUFFER ADDR ; $IOSET: CLR BFLP(R2) ;CLEAR LINK PTR MOV DVPDVN(R1),BFPDVN(R2) ;SET PHYS DEV NAME MOVB DVUNUM(R1),BFUNUM(R2) ;SET UNIT NUM CLR BFHOPN(R2) ;CLEAR HOW OPEN/ERR CODE MOV DVFLNM(R1),BFFLNM(R2) ;MOV R4,R0  ;ADDR ERR ENTRY IN R0 MOV (SP)+,R5 ;RESTORE R5-R1 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV 2(R0),R0 ;PUT TRANS ADDR IN R0 RTS R0  ;RESTORE R0 AND JUMP TO TRANS ADDR    ;AS IF USER CALLED DIRECTLY ; $RTS: RTS R5  ;DEFAULT EXIT FROM TRANS VEC ;    ;IS TO RETURN TO CALLER ; ; ; MESSAGE IS TO BE LOGGED, CHECK IF LOG FILE AVAILABLE ; LOG: MOV #$DEVTB,R5 ;CHECK IF LOG DEVICE AVAILABLE MOV #$IOBUF,R2  MOV 2(R5),R1015,(R1) ;PUT IN CR,LF MOVB #11,6(R5) ;PUT IN TITLE MOV #"NA,(R5) MOV #"ME,2(R5) MOVB #'S,7(R5) MOV #"EQ,8.(R5) MOV #16.,R0  ;SET REC LEN JSR PC,WRIT  ;WRITE TITLE LINE ; ; MOV $NAMC,R4 MOV $SEQC,R1 TBK1: MOV R1,-(SP) ;PUSH SEQ NUM MOV R5,-(SP) ;REC LOC WHERE TO GO ADD #7,(SP) MOV #3,-(SP) EMT 42  ;CVT TO DECIMAL CHARS ; MOV 6(R4),-(SP) ;PUSH 2ND WRD NAME MOV 4(R4),-(SP) ;PUSH 1ST WRD NAME MOV R5,-(SP) ;PUSH ADDR IN REC 1 .TITLE DVTB06 .GLOBL $DEVTB .CSECT ; ; $DEVTB V006A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ;THESE ARE THE FORTRAN DEVICE TABLE ENTRIES ;WITH THE DEVICE TABLE HEADER AND ENTRY VECTOR ; .WORD DEVERR  ;ADDR OF ENTRY FOR ERR MSG FILE $DEVTB: .WORD 8.  ;NUMBER OF ENTRIES IN ENTRY VECTOR .WORD 6.  ;DEVICE NUM OF ERROR LOGGING DEVICE ; ;THE DEVICE TABLE ENTRY VECTOR ; .WORD DEV1  ;ADDR OF DEVICE 1 ENTRY .WORD DEV2  ;ADDR OF DEVICE 2 ESET FILE NAME AND EXT MOV DVFLNM+2.(R1),BFFLNM+2(R2) MOV DVFLNM+4.(R1),BFFLNM+4(R2) MOV DVUIC(R1),BFUIC(R2) ;SET UIC MOVB DVPC(R1),BFPC(R2) ;SET PROTECT CODE ; MOV R0,-(SP);CONVERT DEVICE NUM TO ASCII STRING MOV R2,-(SP) ADD #BFPTR,(SP) MOV #3,-(SP) EMT 42   ;DO BIN2D ; MOV R2,R3  ;CONVERT ASCII STRING TO ADD #BFPTR+2,R3  ;RAD50 IOSET1: CMPB #'0,(R3) BNE IOSET2 INC R3 MOVB #' ,2(R3) BR IOSET1 IOSET2: MOV R3,-(SP) CLR -(SP) ;RUN ASCII OUTPUT BLE NOLOG  ;BRANCH IF NO DEVICE NUM ASL R1 ADD R5,R1 MOV 2(R1),R1 BEQ NOLOG  ;BRANCH IF NO DEVTB ENTRY BITB DVSW(R1),#6 BNE NOLOG  ;BRANCH IF RANDOM OR UNFMT FILE TSTB DVHOPN(R1)  BEQ OPNLOG  ;GO OPEN IF CLOSED CMPB DVHOPN(R1),#2 ;IF OPEN CHECK IF OPENO BNE NOLOG  ;BRANCH IF NOT BR LOGOPN  ;GO SET UP TO LOG MSGS ; OPNLOG: MOV R0,-(SP) ;SAVE R0 MOV 2(R5),R0 ;MOVE DEVICE NUMBER TO R0 JSR PC,$IOSET ;COME HERE TO ST 3 CHARS MOV #1,-(SP) EMT 42  ;RADUP MOV R5,-(SP) ;PUSH ADDR IN REC 2ND 3 CHARS ADD #3,(SP) MOV #1,-(SP) EMT 42  ;RADUP ; JSR PC,WRIT  ;WRITE LINE MOV 2(R4),R1 ;GET NEXT SEQ NUM MOV (R4),R4  ;GET NEXT NAME BNE TBK1 JMP ENDTRC  ;IF NONE RETURN ; ; WRIT: MOV R0,2(R2) ;SET LENGTH MOV R0,6(R2) MOV R5,8.(R2) ;SET BUFF ADDR MOV #24,4(R2) ;SET FMTD SPECIAL ASCII,    ; DUMP, DETACH MOV R2,-(SP) ;WRITE ADD #2,(SP) MOV NTRY .WORD DEV3  ;ADDR OF DEVICE 3 ENTRY .WORD DEV4  ;ADDR OF DEVICE 4 ENTRY .WORD DEV5  ;ADDR OF DEVICE 5 ENTRY .WORD DEV6  ;ADDR OF DEVICE 6 ENTRY .WORD DEV7  ;ADDR OF DEVICE 7 ENTRY .WORD DEV8  ;ADDR OF DEVICE 8 ENTRY ; ; ; ;ENTRY 1 OF DEVICE TABLE ; DEV1: .WORD 0  ;LINK BLOCK PTR .RAD50 /DF /  ;PHYSICAL DEVICE NAME DEFAULT .BYTE 0  ;HOW OPEN SWITCH .BYTE 0  ;UNIT NUM DEFAULT .RAD50 /FOR/  ;DEFAULT FILE NAME .RAD50 /001/ .RAD5EMT 42   ;DO RADPK ; MOV (SP)+,BFLDSN(R2) ;SET LOG DATASET NAME TST (SP)+ ; RTS PC ; ; OPEN LOGGING DEVICE MOV (SP)+,R0 ;RESTORE R0 MOVB R0,R3  ;RESTORE R3 MOV #LOGRI,BFLKER(R2) ;SET LINK BLOCK ERR RET MOV #LOGRO,BFFLER(R2) ;SET FILE BLOCK ERR RET MOV R2,-(SP) EMT 6  ;INIT MOVB #2,BFHOPN(R2) ;SET TO OPENO MOV R2,-(SP) ADD #BFFLNM,(SP) MOV R2,-(SP) EMT 16  ;OPEN MOV R2,-(SP) EMT 1  ;WAIT MOVB BFHOPN(R2),DVHOPN(R1) ;SET OPENO IN DEVICE ENTRY INCB DVSW(R1) ;SET FMTD I/O MOV BFLP(R2),DVLP(R1) ;SAVE LINK PTR BR LOGOPNR2,-(SP) EMT 2 MOV R2,-(SP) EMT 1  ;WAIT BITB #100,5(R2) ;CHECK FOR EOF BNE EOFW  ;REPORT TO CALLER IF SO RTS PC  ;CONTINUE IF NOT EOFW: INC R3  ;SET ERROR CONDITION TST (SP)+  ;REMOVE OLD PC BR EOFX ENDTRC: CLR R3 EOFX: MOV (SP)+,R4 ;RESTORE REGS MOV (SP)+,R1 MOV (SP)+,R0 TST (SP)+ RTS PC  ;RETURN ; ; .IFNZ REGSW ; RNMS: .ASCII /R0R1R2R3R4R5PCSP/ ; .ENDC ; .END 0 /DAT/  ;DEFAULT EXTENSION .BYTE 233  ;NO AUTO DEL, GROUP & OTHERS READ/RUN ONLY .BYTE 0  ;DEVICE STATUS SWITCH .BYTE 0  ;MODE OF I/O - FUNCN WORD (RANDOM) .BYTE 0  ;STATUS OF I/O .WORD 0  ;RECORD COUNT - BLOCK NUM (RANDOM) .WORD 0  ;BUFF ADDR (RANDOM) .WORD 0  ;BUF LEN (RANDOM) .WORD 0  ;ASSOCIATED VAR ADDR (FROM DEFINE FILE) .WORD 0  ;NUM RECORDS IN FILE (FROM DEFINE FILE) .WORD 0  ;RECORD LENGTH (FROM DEFINE FILE) .WORD 0  ;USER ID C .TITLE IOBF01 ; ; $IOBUF V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $IOBUF .CSECT ; ;THIS IS THE FORTRAN I/O BUFFER WITH ASSOCIATED LINK BLOCK, ;FILE BLOCK AND BUFFER HEADER WHICH IS USED FOR ALL FORTRAN I/O. ; BFLKER: .WORD 0  ;ERROR RETURN ADDR - LINK BLOCK $IOBUF: .WORD 0  ;LINK PTR BFLP=$IOBUF BFLDSN: .WORD 0  ;LOG DATASET NAME .BYTE 1  ;DEV NAME PRESENT VALUE BFUNUM: .BYTE 0  ;UNIT NUM BFPDVN: .WORD 0  ;PHYSICAL ; LOGRI: LOGRO: MOV R2,-(SP) ;ERRORS ON INIT OR OPEN - EMT 7  ;RLSE DATA SET ; ; NO LOGGING DEVICE ; NOLOG: SUB R3,R0  ;MODIFY ERROR CLASS AND NUM TO ASL R0  ;LOOK GOOD ON OUTPUT ADD R3,R0  MOV R0,-(SP) ;PUSH IT ON STACK MOV NLOGD,-(SP) ;SET INFORMATION NO LOG DEV 1 IOT   ;MONITOR DIAGNOSTIC JMP LOGD  ;GO END UP ERROR PROCESSING ; NLOGD: .BYTE 353  ;NUM OF DIAG .BYTE 0  ;INFORMATIONAL (NO LOG DEV) DIAGNOSTIC ; LOGOPN: MOV DVLP(R1),BFLc IQ$@Sb3D/S S h\ 8%bVl@9 b@9 b D nv^ d l@L l@L@ Jt@vnp d@Y dZR.`0@0|@j@ j@S`0/Z-R.`0@0|@jZ h@ Jt@`0`@D `0^ $Z jZ-h\ 8%``0@4@j@S`0/Z-R.`0@0'|@ jZ h@ Jt@`0@D `0^ 4Z jZ-h\ 8%``0@E@jYtEѠ@ Jt@v`` ERT@ 9A: E@Sb24/@BD h^D ER.`1@76|@ 2 h\ 8%bb@@ H@ Jt@`0ODE .WORD 0  ;ERROR VAR ADDR (FROM SETFIL) ; ; ; ;ENTRY 2 OF DEVICE TABLE ; DEV2: .WORD 0 .RAD50 /DF / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /002/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ; ;ENTRY 3 OF DEVICE TABLE ; DEV3: .WORD 0 .RAD50 /DF / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /003/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ; ;ENTRY 4 OF DEVICE TABLE ; DEV4: .WORD 0 .RAD50 /PR / .BYTE 0,0 .RAD50DEVICE NAME BFFLER: .WORD 0  ;ERROR RETURN ADDR - FILE BLOCK BFHOPN: .BYTE 0  ;HOW OPEN FLAG BFERCD: .BYTE 0  ;ERROR RETURN CODE BFFLNM: .WORD 0  ;FILE NAME .WORD 0 .WORD 0  ;EXTENSION NAME BFUIC: .WORD 0  ;UIC BFPC: .BYTE 0  ;PROTECT CODE .BYTE 0  ;SPARE BFMCNT: .WORD 136.  ;MAXIMUM BYTE COUNT - BUFF HEADER BFMODE: .BYTE 0  ;I/O MODE BFSTAT: .BYTE 0  ;I/O STATUS BFACNT: .WORD 0  ;ACTUAL BYTE COUNT BFPTR=.    ;BUFFER .=.+136. ; ; P(R2) ;SET LINK PTR IN BUFF CLR BFLKER(R2)    ;USE NEXT 4 WORDS OF IOBUF AS LINE    ;BUFF HDR SO THAT ACTUAL LINE BUFF    ;HDR AND LINE BUFF ARE NOT DISTURBED ; ; NOW CHECK IF MSG FILE EXISTS ; MOV -(R5),R5 ;GET ADDR MSG FILE FROM DEVTB HDR BEQ NOMSG1  ;BRANCH IF NONE TST (R5) BNE MSGOPN  ;BRANCH IF ALREADY OPEN MOV R5,-(SP) EMT 6  ;INIT MOV #NOMSG,10(R5) MOV R5,-(SP) ADD #14,(SP) MOV R5,-(SP) EMT 16  ;OPEN MOV R5,-(SP) c9D ITdQH}JA@Sbp/@[*AZ\@  dAR.h1@3{@ ؜$@ ؜1@Sb4Tp/S S h\ 8%bfn@69b@ 9bD `V^æ l@LB l@LH@ Jt@`0@D `0^ 4Z jZ-h\ 8%``0@E@j@Sb$r/@]*AZ\@ 9A: E9 b D fV^ $˦ l@LZ l@L`@ Jt@Vjh d@M dNR.j1@0{@ ؜@ ؜@Sb1$r/šS S h\ 8%``0@@j@S`0r/Z-R.`0@0{@jZ h@ Jt@n1`@ /FOR/ .RAD50 /004/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 5 OF DEVICE TABLE ; ; DEV5: .WORD 0 .RAD50 /LP / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /005/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 6 OF DEVICE TABLE (LOGGING DEVICE NOTE PHYS DEV NAME) ; ; DEV6: .WORD 0 .RAD50 /KB / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /006/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 7 OF ; EMT 1  ;WAIT MSGOPN: MOV R5,-(SP) ;ADDR OF BLOCK BLOCK ADD #26,(SP) MOV R5,-(SP) ;ADDR OF LINK BLOCK MOVB 1(R4),30(R5) ;MOV START BLOCK NUM FOR CLASS ASR R3  ;INTO BLOCK BLOCK AND ADD NUM ADD R3,30(R5) ;BLOCKS TO SPECIFIC MSG EMT 11  ;READ BLOCK MOV R5,-(SP) EMT 1  ;WAIT MOV 32(R5),R5 ;GET ADDR OF MSG BIT #1,R0  ;IF ODD NUM MSG IS IN 2ND BEQ MSG1  ;64 BYTES OF BLOCK ADD #64.,R5  MSG1: MOV #64.,2(R2) ;NOW PREPARE TO WRITE MSG MSG2cyL@TEh\ 8%`6`0@ŴSl|@ d NUb@S`tl/@-$@D ɔr@ ź@S`0l/Z-R.`0@0f{@ jZ h@ Jt@`0l@D `0^ Z jZ-h\ 8%bFh5@Ah8L@̙d@E@,ͤh\ 8%`Vn@CTP89 Z$S(}D l7v^T| IA9~ ř@lKR.`0@0v{@ jZ h@ Jt@`0d@D `0^ DZ jZ-h\ 8%``0@@j@Sb0Dn/Z-  9 dR.n0@3x{@Ҙ|@ 4N(l@ҘR.`1@7x{@@Ԙ@@'G *Q@S`$n/*@=- DEVICE TABLE ; ; DEV7: .WORD 0 .RAD50 /DF / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /007/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ; ;ENTRY 8 OF DEVICE TABLE ; ; DEV8: .WORD 0 .RAD50 /DF / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /008/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;SPECIAL ENTRY FOR ERROR PROCESSORS MSG FILE ; .WORD 0  ;LINK BLOCK ERR RTN ADDR DEVERR: .WORD 0  ;LINK PTR .RAD50 /ERR/  ;LOG DATA : MOV 2(R2),6(R2) ;SET BYTE COUNT MOV R5,8.(R2) ;SET RECORD ADDR (DUMP MODE) MOVB #24,4(R2) ;SET FMTD ASCII SPECIAL WRITE,    ; DUMP, DETACH MOV R2,-(SP) ;ADDR BUF HDR ADD #2,(SP) MOV R2,-(SP) ;ADDR OF LINK BLOCK EMT 2  ;WRITE MOV R2,-(SP) EMT 1  ;WAIT BITB #100,5(R2) ;IF EOF ON LOG DEVICE ABORT RUN BEQ MSGD ; LOGBAD: MOV R1,-(SP) ;PUSH ADDR OF DEVTB ENTRY (LOG DEVICE) MOV LBD,-(SP) ;EOF LOG DEV FATAL ERROR IOT   ;INFORM OF ERROR cD h2&^4 i-9h  x,TA\H,R.`0@8{@j *ZEPE:, D `4^  @D `0^ $Z jZ-h\ 8%``0@4@j@S`0h/Z-R.`0@0G{@ jZ h@ Jt@j0 ɉrUb@ PR.n0@H{@H @҈@Θ@@(Xd@TEh\ 8%`6`0@EP4S<@  Ub@S`6j/@& E@DD `0^ $Z jZ-h\ 8%``0@@j@S`0j/Z-R.`0@0W{@ jZ h@ Jt@Fh9ĚAI @ I$$ S<@S`j/@*: E9M@SET NAME .BYTE 1  ;PHYSICAL DS NAME FOLLOWS .BYTE 0  ;UNIT NUM .RAD50 /DF /  ;PHYSICAL DS NAME .WORD 0  ;FILE BLOCK ERROR RETURN ADDR .BYTE 4  ;HOW TO OPEN (OPENI) .BYTE 0  ;ERROR RTN CODE .RAD50 /FOR/  ;FILE NAME .RAD50 /TRN/ .RAD50 /MSG/ .BYTE 1  ;USER ID CODE .BYTE 1 .BYTE 322,0  ;ALLOW ONLY INPUT ACCESS .WORD 2  ;FUNCTION WORD (READ) .WORD 0  ;BLOCK NUM .WORD 0  ;BLOCK ADDR .WORD 0  ;BLOCK LENGTH ; ; BR LOGD  ;AND CONTINUE AT USER OPTION LBD: .BYTE 352  ;NUM OF DIAG .BYTE 0  ;INFORMATIONAL - EOF LOG DEV NOMSG: MOV R5,-(SP) EMT 7  ;RELEASE NOMSG1: CLRB R0 SWAB R0 MOV R0,-(SP) ;PUSH CLASS NUMBER MOV R3,-(SP) ;PUSH ERROR NUMBER MOV #$ERRWK,R5 ;SET UP LINE BUFF AREA    ;LINE = FORT000000CRLF MOV R5,-(SP) TST (R5)+ ADD #5,(SP) MOV #3,-(SP) EMT 42  ;CVT ERR NUM TO DECIMAL CHARS MOV R5,-(SP) MOV #3,-(SP) EMT 42  ;CVT ERc D `0^  yL@YEUb@ :A @ƘΙ4CDH@ Jt@`0dIDdSZA%}Nd@R.`0@&{@ AUb@ hŤh\ 8%`vf3@6Y@Dd|T 9)OZ@ 8-(@ Jt@`0p@D `0^  D-MU$Nd@Z@ѐ@ Jt@`0@ΚYR.`0@7({@9 ȼ*@ YLR.`0@06{@ j@ j@S`6f/S9tRt@IL@EZ-h\ 8%``0@  BPYuRL ,E:ODH@ Jt@`0l $-CUNd@ S:Mp@ Jt@`0p@D `0^ Z jCI 5Ndc)5D Z.P0JUYZTLU Z $}NDŒTUl HLT8B!#DtSTIH*d@HWдUDBh4@H R5 HL@HOHL@HbXL@ÑHt@h}@XD Ap 4 S 28}u*DO Z.PA60JI b "A4TYP L@ AXYPl1R9A: Eᚦ#bTK^$-Ti "A @OꬆAZ#dTK^$-Ti 9 9A: E ә\Ρh`USi|Ib4P4\2h"nv^@Ś@S֢\h"ȕZ@TlZE 8L$@HOdF: ,Eyp SP } @OX "ER CLASS TO DECI CHARS MOV #5015,8.(R5) ;PUT IN CR LF MOV #"RT,(R5) MOV #"FO,-(R5) MOV #12,2(R2) ;SET BUF LGN IN BUF ADR BR MSG2  ;GO WRITE ; MSGD: JSR PC,$TRCBK ;GO GEN TRACE BACK TST R3  ;ABORT IF EOF ON LOG DEV BNE LOGBAD  LOGD: TST 4(R4)  ;IF IGNORE TYPE ERROR BNE LOGD1 LOGD2: JMP ERRX  ;RETURN THRU TRANS VEC LOGD1: INC 6(R4)  ;ELSE INC ERR CNT FOR CLASS CMP 6(R4),4(R4) ;CHECK IF MAX REACHED BLT LOGD2 MOV #2,$EXSW ;IFSO CALL EXIT c*Ub@ Y$E(@ Jt@`0p@D `0^ @Td|MXu@ZlU