; .CSECT .TITLE V011A ;IDENTIFIES VERSION NUMBER OF THIS   ;LIBRARY. SHOULD BE UPDATED FOR   ;EACH NEW VERSION OF THE LIBRARY .END ; ;  .TITLE $POP02 ; ; $POP V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; POP ROUTINES - POLISH LIST CONTAINS ADDRESS OF DATA ; DESTINATION FOLLOWING THE POP CALL. ; ; $POP4,$POP5 - POP A 4 WORD (DOUBLE OR COMPLEX) ITEM ; .GLOBL $POP4,$POP5 $POP5: $POP4: MOV (R4)+,R3 ;GET DESTINATION ADDRESS POP4B: MOV (SP)+,(R3)+ ;COPY MOV (SP)+,(R3)+ ;FIRST HALF OF .TITLE SVSP02 ; ; $SVSP V002A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; THE FOLLOWING ROUTINE SAVES STACK ADDRESSES AT ADDRESS ; SPECIFIED FOLLOWING THE CALL. THIS ROUTINE IS USED ; FOR ADDRESS SUBSTITUTION IN SUBROUTINE CALLS. ; .GLOBL $SVSP $SVSP: MOV SP,@(R4)+ ;SAVE SP AT SPECIFIED ADDRESS JMP @(R4)+  ;THEN CONTINUE ; .END  .TITLE PSHR06 ; ; $PSHR V006A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ;THIS ROUTINE PLACES ONE, TWO, OR FOUR ITEMS ON THE STACK ; FROM THE REGISTERS R0-R3. IT IS USED AFTER FUNCTION ; CALLS TO PLACE THE FUNCTION RESULT ON THE STACK ; .GLOBL $PSHR5,$PSHR4,$PSHR3,$PSHR2,$PSHR1 $PSHR5: $PSHR4: MOV R3,-(SP) ;PUSH FOUR WORDS MOV R2,-(SP) $PSHR3: MOV .TITLE POPR03 ; ; $POPR V003A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE REMOVES ONE, TWO OR FOUR ITEMS FROM THE STACK ; AND PLACES THEM IN REGISTERS R0-R3. IT IS USED IN EXTERNAL ; FUNCTIONS TO RETURN THE FUNCTION VALUE IN THE REGISTERS ; .GLOBL $POPR5,$POPR4,$POPR3,$POPR2,$POPR1 ; $POPR5: $POPR4: MOV (SP)+,R0 ;POP FOUR WORDS MOV (SP)+,R1 MOV (SP)+,R2 MOV  ITEM POP4A: MOV (SP)+,(R3)+ ;COPY SECOND HALF MOV (SP)+,(R3)+ ;OF ITEM JMP @(R4)+  ;DISPATCH TO NEXT ROUTINE IN LIST ; ; $POP3 - POP A REAL ITEM ; .GLOBL $POP3 $POP3: MOV (R4)+,R3 ;GET DATA DESTINATION BR POP4A  ;GO MOVE THE DATA ; ; $POP1,$POP2 - POP AN INTEGER OR LOGICAL ITEM ; .GLOBL $POP1,$POP2 $POP2: $POP1: MOV (SP)+,@(R4)+ ;MOVE THE DATA TO THE DESTINATION JMP @(R4)+  ;THEN CONTINUE ; $POP0 - POP A BYTE ITEM ; .GLOBL $POP0 $POP0: MOVB (SP)+ .TITLE $PUT02 ; ; $PUT V002A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; PUT - ONE, TWO, OR FOUR WORDS ; .GLOBL $PUT5,$PUT4,$PUT3,$PUT2,$PUT1 $PUT5: $PUT4: MOV (SP)+,(R0)+ ;PUT FOUR WORDS MOV (SP)+,(R0)+ $PUT3: MOV (SP)+,(R0)+ ;PUT TWO WORDS $PUT2: $PUT1: MOV (SP)+,(R0)+ ;PUT ONE WORD JMP @(R4)+ ; .GLOBL $PUT0 $PUT0: MOVB (SP)+,(R0)+ R1,-(SP) ;PUSH TWO WORDS $PSHR2: $PSHR1: MOV R0,-(SP) ;PUSH ONE WORD JMP @(R4)+ ; .GLOBL $PSHR0 $PSHR0: MOVB R0,-(SP) ;PUSH ONE BYTE JMP @(R4)+ ; .END (SP)+,R3 JMP @(R4)+ $POPR3: MOV (SP)+,R0 ;POP TWO WORDS MOV (SP)+,R1 JMP @(R4)+ $POPR2: $POPR1: MOV (SP)+,R0 ;POP ONE WORD JMP @(R4)+  ;AND CONTINUE ; .GLOBL $POPR0 $POPR0: MOVB (SP)+,R0 ;POP ONE BYTE JMP @(R4)+ ; .END ,@(R4)+ INC R4 JMP @(R4)+ ; ; $POPP4,$POPP5 - POP A 4 WORD (DOUBLE OR COMPLEX) PARAMETER ; .GLOBL $POPP4,$POPP5 $POPP5: $POPP4: MOV (R4)+,R3 ;GET DISPLACEMENT ADD R5,R3  ;ADD IT TO LIST ADDRESS MOV @R3,R3  ;GET THE VARIABLE ADDRESS BR POP4B  ;GO TO COMMON CODE ; ; $POPP3 - POP A REAL PARAMETER ; .GLOBL $POPP3 $POPP3: MOV (R4)+,R3 ;GET DISPLACEMENT ADD R5,R3  ;ADD TO THE LIST ADDRESS MOV @R3,R3  ;GET THE VARIABLE ADDRESS BR POP4A ; .END JMP @(R4)+ ; .END .TITLE $PUT01 ; ; $PUT V001A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 .TITLE POLH01 .GLOBL $POLSH ; ; $POLSH - IS CALLED WHENEVER IT IS DESIRED TO ENTER POLISH ; MODE FROM IN-LINE CODE. ; IT MUST BE CALLED VIA A JSR R4,$POLSH ; ; $POLSH V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 SP=%6 .CSECT ; $POLSH: TST (SP)+  ;DELETE JUNK FROM STACK JMP @(R4)+  ;WE'RE NOW IN POLISH MODE ; .END  .TITLE $ASP03 ; ; $ASP V003A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .GLOBL $ASP ; ; $ASP ; ; ASSIGN TO DUMMY PARAMETER TYPE VARIABLE ; CALLING SEQUENCE: ; ; $ASP  ;SERVICE NAME ; .K  ;LABEL ADDRESS ; OFFSET  ;PARAMETER OFFSET IN CALL ; $ASP: MOV (R4)+,-(SP) ;LABEL TO STACK BR $POPP1  ;LET INTEGER POP TO PARAMETER    ;DO THE REST ; .TITLE $PSH01 .GLOBL $PSH ; ; $PSH - PUSH AN ADDRESS OR VALUE ON THE STACK ; ; $PSH V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 SP=%6 ; .CSECT ; $PSH: MOV (R4)+,-(SP) ;ADDRESS TO THE STACK JMP @(R4)+  ;AND NOW RETURN ; .END .TITLE $ADI02 ; ; $ADI V002A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $ADI - ADD INTEGER ; ; .GLOBL $ADI ; $ADI: ADD (SP)+,@SP JMP @(R4)+ ; .END ; $POPP2,$POPP1 - POP AN INTEGER OR LOGICAL PARAMETER ; .GLOBL $POPP2,$POPP1 $POPP2: $POPP1: MOV (R4)+,R3 ;GET THE ADD R5,R3 ; VARIABLE ADDRESS MOV @R3,R3 MOV (SP)+,@R3 ;STORE THE VALUE JMP @(R4)+ ;AND EXIT ; .GLOBL $POPP0 $POPP0: MOV (R4)+,R3 ADD R5,R3 MOV @R3,R3 MOVB (SP)+,@R3 JMP @(R4)+ ; .END .TITLE $CMI01 ; ; $CMI V001A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .GLOBL $CMI ; ; $CMI - COMPARE INTEGER ; $CMI: SUB (SP)+,(SP)+ JMP @(R4)+ ; .END .TITLE $SBI01 ; ; $SBI V001A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .GLOBL $SBI ; ; $SBI - SUBTRACT INTEGER ; $SBI: SUB (SP)+,@SP JMP @(R4)+ ; .END ; .TITLE $TRX01 .GLOBL $TRX,$ERR .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; $TRX V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS ; ; COMPUTED GOTO - RUN TIME ROUTINE ; INTEGER INDEX ON STACK ON ENTRY, DELETED ON EXIT ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH INDEX ON STACK ; $TRX  ;ENTRY ADDRESS ; K  ;NUMBER OF PARAMETERS ; .N1  ;WHERE N1 IS STATEMENT NUMBER ; .N2  ;ETC. ; ... ; .NK ; $TRX:  .TITLE $TRA01 .GLOBL $TRA,$TRAL,$AS,$ERR .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; $TRA V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS ; ; ASSIGNED GOTO - RUN-TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRA  ;ENTRY ADDRESS ; $TRA: MOV (SP)+,R4 ;MOVE VALUE TO R4 AND JMP @(R4)+  ;DISPATCH ; ; $TRAL ; ; ASSIGNED GOTO WITH CHECK LI; ; $TR (GOTO) COMMAND ; .TITLE $TR01 .GLOBL $TR ; ; $TR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 ; $TR: MOV @R4,R4  ;PICK UP TRANSFER ADDR JMP @(R4)+  ;AND TRANSFER ; .END ; $ADJ V002A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ;OTS ROUTINE FOR INITIALIZING ADJUSTABLE ARRAYS ; ;$ADJ,,,<1ST DIM. PAR INDEX>, ;<2ND DIM. PAR INDEX>,<3RD DIM. PAR INDX> ; ;ANY PARAMETER INDEXES TO BE IGNORED WILL BE -1. ;R0,R1,R3 CLOBBERED: R4 ADVANCED OVER PARAMETERS ; .TITLE ADJ02 .GLOBL $ADJ R0=%0 R1=%1 R3=%3 R4=%4 R5=%5 ; $ADJ: MOV (R4)+,R0 ;GET ADDR OF ADB MOV (R4)+,R1 ;PICK UP ARRAY BASE ADDR. MOV (SP)+,R0 ;CLEAR STACK AND SAVE I CMP R0,#1  ;CHECK LIMITS ON I BLO $TRX1  ;I LESS THAN ONE CMP R0,@R4  ;COMPARE TO MAXIMUM BLOS $TRX2  ;JUMP IF OK ; ; ERROR - GIVE OTS ERROR AND THEN CONTINUE ; DEFAULT IS TO FALL THROUGH TO NEXT STATEMENT ; $TRX1: JSR R5,$ERR  ;OTS ERROR ROUTINE BR $TRX3  ;R0=INDEX VALUE 1   ;CLASS=1,NUM=0 $TRX3: MOV (R4)+,R0 ASL R0 ADD R0,R4 JMP @(R4)+ ; ; NORMAL ACTION ; $TRX2: ASL R0 ADD R0,R4 MOV @R4,R4 ST - RUN TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRAL  ;ENTRY ADDRESS ; .N1,.N2,.N3,0 ;LEGAL LABELS TERMINATED BY ZERO ; $TRAL: MOV (SP)+,R0 ;POTENTIAL DESTINATION $TRAL1: MOV (R4)+,R1 ;LOOK AT NEXT LABEL BEQ $TRAL9 ;JUMP IF NOT FOUND CMP R0,R1 BNE $TRAL1  ;GO LOOK FARTHER MOV R0,R4  ;NOW JMP @(R4)+  ; GO AWAY ; RUN-TIME DIAGNOSTIC $TRAL9: JSR R5,$ERR ;ERROR BR .+4 1   ;CLA; ;$TRTST OTS ROUTINE FOR SERVICING LOGICAL IF STATEMENTS. ; ;$TRTST, ;THE TOP OF THE STACK IS TESTED (AND POPPED). IF ITS VALUE ;IS .FALSE. (=0), CONTROL GOES TO IN POLISH MODE. ;OTHERWISE, CONTROL GOES TO THE WORD FOLLOWING THE PARAMETER ;IN POLISH MODE. ; .TITLE TRST01 ; ; $TRTST V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .GLOBL $TRTST R4=%4 SP=%6 ; $TRTST: TST (SP)+ ;LOOK AT VALUE AND POP IT BEQ $TRST1 ;BR IF FALSE TST ADD R5,R1 MOV (R1),(R0)+ ;INTO 1ST WD OF ADB MOV #3,R3 ;INITIALIZE LOOP $ADJ3: BEQ $ADJ1 ;LOOP FINISHED? TST (R0)+ ;NO POINT TO NEXT ADB WORD MOV (R4)+,R1 ;GET NEXT PARAMETER INDEX BMI $ADJ2 ;IF NEGATIVE, IGNORE ADD R5,R1 ;ELSE COMPUTE ADDR OF PARAMETER ADDR. MOV @(R1),(R0) ;MOVE ACTUAL PARAMETER VALUE INTO ADB $ADJ2: DEC R3 ;DECR. LOOP CTR BR $ADJ3 $ADJ1: JMP @(R4)+ ;RETURN .END JMP @(R4)+ ; .END SS=1/NUMBER=0 JMP @(R4)+  ;DEFAULT CONTINUE ; ; $AS ; ; ASSIGN LABEL TO VARIABLE ; CALLING SEQUENCE: ; ; $AS  ;SERVICE NAME ; .K  ;LABEL ADDRESS ; NAME  ;NAME OF VARIABLE ; $AS: MOV (R4)+,@(R4)+ ;STORE THE LABEL JMP @(R4)+ ; .END (R4)+ ;SKIP OVER PARAMETER JMP @(R4)+ ;AND FALL THROUGH $TRST1: MOV (R4),R4 ;TRANSFER CONTROL TO JMP @(R4)+ .END ; .TITLE PSHP01 ; ; $PSHP V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; ; $PSHP - PUSH A PARAMETER ADDRESS ; .GLOBL $PSHP ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; .CSECT $PSHP: MOV (R4)+,R0 ADD R5,R0 MOV @R0,-(SP) JMP @(R4)+ ; .END ; ; GET AN ARRAY ADDRESS FROM THE ADB ; .TITLE $SVA01 .GLOBL $SVA ; ; $SVA V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; R4=%4 SP=%6 ; $SVA: MOV @(R4)+,@(R4)+ JMP @(R4)+ ; .END .TITLE $SVP01 ; ; $SVP V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; GET ADDRESS OF PARAMETER AND STORE IT IN PARAMETER LIST ; .GLOBL $SVP $SVP: MOV (R4)+,R0 ;GET PARAMETER POSITION ADD R5,R0  ;GET ADDRESS OF PARAMETER ADDRESS MOV @R0,@(R4)+ ;PUT THE ADDRESS AWAY JMP @(R4)+  ;AND RETURN ; .END .TITLE $SVE01 ; ; $SVE V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; SAVE ADDRESS OF SINGLE ARRAY ELEMENT ; .CSECT R0 = %0 R4 = %4 ; .GLOBL $SVE $SVE: MOV R0,@(R4)+ ;STORE THE ADDRESS JMP @(R4)+  ;AND RETURN ; .END ' .TITLE ENDO03 .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $ENDDO V003A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; $ENDDO - DO STATEMENT END PROCESSING, REQUIRES FOUR PARAMETERS. ; 1 - STEP VALUE ADDRESS ; 2 - CONTROL VARIABLE ADDRESS ; 3 - END VALUE ADDRESS ; 4 - ADDRESS OF LOOP BEGINNING ; ; .GLOBL $ENDDO,$ENDDP $ENDDO: ADD @(R4)+,@(R4) ;INCREMENT CONTROL VARIABLE CMP @(R4)+,@(R4)+ ;COMPAR .TITLE $ANI02 .GLOBL $ANI .CSECT ; R4=%4 SP=%6 ; ; $ANI V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; $ANI - PERFORMS LOGICAL 'AND' OF THE TOP TWO STACK ELEMENTS ; AND RETURNS THE RESULT ON THE STACK ; ; A .AND. B = .NOT. ( .NOT. A .OR. .NOT. B ) ; $ANI: COM (SP) COM 2(SP) BIS (SP)+,(SP) COM (SP) ANIX: JMP @(R4)+  ;AND RETURN ; .END .TITLE $ORI01 .GLOBL $ORI .CSECT ; R4=%4 SP=%6 ; ; $ORI V001A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; $ORI - PERFORMS LOGICAL 'INCLUSIVE OR' OF THE TOP TWO STACK ; ELEMENTS AND RETURNS THE RESULT ON TOP OF THE STACK. ; $ORI: BIS (SP)+,(SP) ;INCLUSIVE OR JMP @(R4)+  ;AND RETURN ; .END .TITLE $NTI02 .GLOBL $NTI .CSECT ; R4=%4 SP=%6 ; ; $NTI V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; $NTI - PERFORMS LOGICAL 'NOT' OF TOP ELEMENT ; ELEMENT ON THE STACK AND RETURNS. ; $NTI: COM (SP) ; ONE'S COMPLEMENT JMP @(R4)+ ;AND RETURN ; .END +E TO LIMIT BLE TR  ;TEST FOR COMPLETION ENDDO: TST (R4)+  ;DISCARD TRANSFER ADDRESS JMP @(R4)+  ;AND CONTINUE ; ; $ENDDP - DO STATEMENT END PROCESSING, DO PARAMETERS ;   PASSED TO SUBPROGRAMS. ; $ENDDP: JSR PC,GT  ;GET ADDR OF STEP VALUE MOV R0,R1  ;AND STORE IN R1 JSR PC,GT  ;GET CONTROL VARIABLE ADDR MOV R0,R2  ;AND STORE IN R2 JSR PC,GT  ;GET END VALUE ADDR ADD @R1,@R2  ;INCREMENT CONTROL VARIABLE CMP @R2,@R0  ;COMPARE TO LIMIT BGT E, .TITLE $GLE01 .GLOBL $LE,$LT,$EQ,$GT,$GE,$NE .CSECT ; ; $GLE V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; ; PERFORMS TESTS FOR LOGICAL OPERATORS - .LE., .LT., .EQ., ; .GT., .GE., .NE. AND RETURNS A VALUE OF .TRUE. OR ; .FALSE. ON THE STACK. ; ; ASSUMES CONDITION CODES 'N' & 'Z' PROPERLY SET BY $CMI, ; $CMR, $CMD ETC. ; R4=%4 SP=%6 ; ; $LE - TRUE IF Z=1 OR N=1 ; $LE: BEQ LT ;SET TRUE IF = OR ; ; $LT - TRUE IF N=1 ; $LT: BMI LT ;SE- .TITLE $GET02 ; ; $GET V002A ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; GETTING AN ITEM FROM OR PUTTING AN ITEM TO AN ADDRESS ; SPECIFIED IN R0 (THE STACK IS THE OTHER OPERAND). ; ; GET - ONE, TWO, OR FOUR WORDS ; .GLOBL $GET5,$GET4,$GET3,$GET2,$GET1 $GET5: $GET4: MOV 6(R0),-(SP) ;FOUR WORD CASE MOV 4(R0),-(SP) ; $GET3: MOV 2(R0),-(SP) ;TWO WORD CAS.)+   ;BUMP WORD DCZL2: CMP R4,R2   ;TOO HI> BHIS DCZW1   ;YUP CMP R1,#20 BLO DCZL0 DCZL3: CLR (R4)+   ;CLEAR NEXT WORD SUB #20,R1 BEQ DCZW1   ;ZOMBO COUNTER BR DCZL2 DCZW1: JSR PC,DCWRIT1  ;WRITE THIS MAP MOV @BUFADR(BIBREG),BLOCK(BIBREG) BEQ DCZDUN   ;ALL DONE JSR PC,DCREAD1  ;GET NEXT MOV BUFADR(BIBREG),R4 ADD #10,R4 BR DCZL0   ;RESET POINTERS + GO DCZDONE: JSR PC,DCWRIT1 DCZDUN: MOV (R6)+,BLOCK(BIBREG) ;READ BNDDO  ;TEST FOR COMPLETION TR: MOV @R4,R4  ;TRANSFER TO START OF LOOP HERE JMP @(R4)+   GT: MOV (R4)+,R0 ;GET PARAMETER CMP R0,#400  ;DETERMINE IF ADDR OR INDEX BHI GTX  ;EXIT IF ADDR ADD R5,R0  ;OTHERWISE INDEX OFF R5 TO GET ADDR MOV @R0,R0 GTX: RTS PC ; .END T TRUE IF <, ELSE ; LF: CLR -(SP) ;SET STACK TO FALSE JMP @(R4)+ ;AND RETURN ; ; $EQ - TRUE IF Z=1 ; $EQ: BNE LF ;SET FALSE IF <>, ELSE ; LT: MOV #-1,-(SP) ;SET STACK TO TRUE JMP @(R4)+ ;AND RETURN ; ; $GT - TRUE IF Z=0 AND N=0 ; $GT: BEQ LF ;SET FALSE IF = OR ; ; $GE - TRUE IF Z=1 OR N=0 ; $GE: BMI LF ;SET FALSE IF < BR LT ;ELSE SET TRUE ; ; $NE - TRUE IF Z=0 ; $NE: BNE LT ;SET TRUE IF <> BR LF ;ELSE SET FALSE ; .END E $GET2: $GET1: MOV @R0,-(SP) ;SINGLE WORD CASE JMP @(R4)+ ; .GLOBL $GET0 $GET0: MOVB @R0,-(SP) ;BYTE CASE JMP @(R4)+ ; .END 2M IF IT WAS IN CORE MOV (R6)+,BUFADR(BIBREG) BEQ DCDUN1 JSR PC,DCREAD1 DCDUN1: MOV 14(R6),WC(R0)  ; RESTORE ORIG WC MOV #20,-(R6) MOV @#S.RBUF,R5 JSR R5,@R5 DCDUN2: MOV @#S.RSAV,R5 JSR R5,@R5  ; SET UP STACK FOR EXIT THRU MON MOV @#S.EXIT,R5 TSTB DELCONTIG BNE .+4 CMP (R5)+,(R5)+ MOV R5,PC   ; GO BABY  ; FS COMMON READ/WRITE ROUTINE DCWRIT1: MOVB #OUT,R5 BR .+6 DCREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD 3T BUFADR IN DDB JSR PC,DWRIT1  ; WRITE IT TST (R6)+   ; SKIP OVER TOP ELEMENT MOV (R6)+,BLOCK(R0)  ; IF A BIT MAP WAS ORIG IN MOV (R6)+,BUFADR(R0) ; CORE, THEN READ IT BACK BEQ .+6 JSR PC,DREAD1 MOV #20,-(R6)  ; RELEASE THE BUF MOV @#S.RBUF,R5 JSR R5,@R5 MOV @#S.RSAV,R5 JSR R5,@R5  ; SET UP STACK FOR EXIT THRU MON MOV @#S.EXIT,R5 TSTB DELNK BNE .+4 CMP (R5)+,(R5)+ MOV R5,PC   ; GO BABY  ;STACK LOOKS LIKE THIS FOR 4; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #FSOPEN-.,@R6 MOV #20,-(R6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT ERR1A: MOV #2,R2  ; FILE DOESNT EXIST BR ERR1Z ERR1B: MOV #3,R2  ; USAGE COUNT EQ 76 OR 77 BR ERR1Z ERR1C: MOV #4,R2  ; FILE LOCKED BR ERR1Z ERR1D: MOV #5,R2  ; OPENE TO A CONTIG FILE BR ERR1Z ERR1E: MOV #6,R2  ; IMPROPER ACCESS PRIV BR E5 CMP (R3)+,(R3)+  ; ...IT IS EITHER 70 OR 74 PLUS N MOV #2,R5   ; SKIP OVER LINK CALCF4: CLR R4   ; R4=FBM IDX CALCF5: CMP R5,@R6   ; R5=DIR IDX? BEQ CALCF6 ADD #22,R5   ; NOPE. GET THE NEXT ITEM ADD #110,R4 CMP R4,#662   ; TOO HI? BLO CALCF5   ; NO INC R3   ; YES...INC FBM BLOCK NUM BR CALCF4   ; RESET POINTERS CALCF6: MOV R4,@R6   ; REPLACE TOP ELEMENT OF STACK WITH FBM IDX MOV R3,-(R6)   ; PUSH BLOCK IDX MOV 10(R6),R5 6BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-DELCONTIG .END  ; END OF DCN Q7  ;DELETION OF LINKED FILES ;  CUR BLOCK  0 ;  CUR BM BLOCK  2 ;  BUFADR FILE  4 ;  BUFADR MAP  6 ;  CURRENT BM#  10 ;  HIS PBM BLOCK#  12 ;  HIS PBM BUFADR  14 ;  BUFADR MFD #1  16 ;  DIR BLOCK  20 ;  DIR BUFADR ;  ADR DIR ENTRY ;  FIL ;  NAM ;  EXT ;  UIC ;  P/MODE ;  RTN ADR  ; FS COMMON READ/WRITE ROUTINE DWRIT1: MOVB #OUT,R5 BR .+6 DREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0GRR1Z ERR7: MOV #7,R2  ; GENERAL ERROR BR ERR1Z ERR8: MOV #10,R2   ; OPENC TO A LINKED FILE BR ERR1Z ERR11: MOV #11,R2  ; FILE ALREADY OPEN FOR OUTPUT    ; OR EXTENSION ON THIS DT BR ERR1Z ERR1Z: TST (R1)+ MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) ADD #12,R6 MOV #BADOPN,R3 ; SET R3 IN CASE 0 RTN ADR BR ERR2C ERR2B: TST (R6)+ ERR2A: MOV @R1,R5  ; NO BUFFER MOV #NOBUFR,R3 ; SET R3 IN CASE 0 ERR RTN ADR CLR FIBLNK(R0)  CLRECLR (R5)+   ; CLR ENTRY CLR (R5)+ CLR (R5)+ JSR PC,DELWRIT1  ; WRITE THE BLOCK MOV @R6,BLOCK(R0)  ; READ FBM INTO THAT BUFFER JSR PC,DELREAD1 MOV R2,BUFADR(R0)  ; READ PBM INTO BUFFER R2 MOV #104,BLOCK(R0) JSR PC,DELREAD1 MOV R2,R5   ; BIC FBM,PBM ADD #10,R5 MOV #36.,R4 MOV 6(R6),R3 ADD 2(R6),R3  ; R3 = BUFADR+FBM IDX BIC @R3,(R5)+ CLR (R3)+   ; CLR FBM DEC R4 BNE .-6 JSR PC,DELWRIT1 MOV (R6)+,BLOCK(R0)  ; F)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-DELNK .END  ; END OF DLN QDD   "@D @"ADDB CO4dhf4dCzh4dgTu4dhfQu4d \g4d df64d  H 4d gX4d4dX4dwX4dX4dX4d4d4dρ4dgh4d1zX4d  @zX4d!!5zX4d""t!b4d#+y4d$$`X4d%%Z4d&&-X4d(,,4d)-$D;)-B%%8a ͋,L w6B ` 5 &  }E >u   d5cU@  Y*  & * D &( 5I'4b Q$ BBB"   U@ e  "U%Gef. U U Bb 0 * BIWRITE FBM CMP (R6)+,(R6)+ MOV (R6)+,BUFADR(R0) JSR PC,DELWRIT1 MOV R2,-(R6)  ; RLS THE R2 BUFFER MOV #20,-(R6) MOV @#S.RBUF,R5 JSR R5,@R5 BR DELEXIT DELWRIT1: MOVB #OUT,R5 BR .+6 DELREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . MOV #PAREK BUFADR(R0) BR ERR2D ERR2C: MOV @PC,-(R6) ; RLS BUFFER IN DDB,ETC. EMT .RLSFIB ERR2D: CLRB 12(R0)  ; CLR FILE OPEN BIT MOV -(R5),14(R6) BNE .+12   ; ERR RTN SPECIFIED MOV @R0,-(R6)  ; NO ERR RTN SPECIFIED.CALL MOV R3,-(R6) ; PUSH ERR CODE & CALL DIAG PRNT IOT CLR R5 BR OPNEX5 NOBUF: MOV @#S.RRES,R5 ; RESTORE REGS,ETC JSR R5,@R5 CMP (R6)+,(R6)+ BR ERR2A  ; FS COMMON READ/WRITE ROUTINE OPNWRIT1: MOVB #OUT,R5 BR .+6L ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREGRR,R3 TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BMI DELDIAG TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-DELETE .END N ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPO OPNREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-FSOPEN P=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =QRMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20  .END  ; END OF FOP _ T14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 U ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 VDIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 W ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAX.RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE DIR .GLOBL DIR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; DIRECTORY SEARCH ;;;;;Y DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DZDTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 [L EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =2\;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DIRS: 177400   ;COMMON CODE TO MOVE CODE    ; FLAG FOR SAM.....NON REENTRANT,0 DIR: ADD PC,R5  ; R5=177776 VIA SAM TST -(R5)  ; LOOK AT FIRST WRD OF CODE TSTB @R5  ; IN SWAP BUFFER? BEQ DIRBEG  ; IF RESIDENT THEN SKIP MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PU]UNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INI^.TITLE PRO .GLOBL PRO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;; PROTECT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ROUTINE_0 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=15`T ADR INTO R3 BNE .+6 JMP DIRRATS  ; TOO BAD MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3  ; FIRST WORD NOW EQ 1 ADD R3,PC  ; GO BABY CLR @R5 CLR -2(R5) 240 DIRBEG: BIT #200,12(R0)  ; TEST DATASET BUSY BEQ .+6   ; IT'S NOT JMP DIER14  ; TOO BAD MOV #1,-(R6)  ; GET A BUFFER AND A FIB EMT .SETUPFIB TST FIBLNK(R0)  ; GET ONE? BEQ DIRNOBUF   ; NOPE SUB #14,R6  ; MaT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE REN .GLOBL REN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;b TO SET PROTECT BIT ; IN USER'S FILES ; ; CALLING SEQUENCE ; MOV #FILE,-(R6) ; MOV #DATASET,-(R6) ; EMT +PROTECT ; ;FILE: FIL ; NAM ; EXT ; UIC ; ;ERROR RETURN: ;  FILE DOESN'T EXIST ;  CALLER IS NOT OWNER ;  FILE IS OPEN PROTECT: 177400   ;COMMON CODE TO MOVE CODE    ; FLAG FOR SAM.....NON REENTRANT,0 PRO: ADD PC,R5  ; R5=177776 VIA SAM TST -(R5)  ; LOOK AT FIRST WRD OF CODE TSTB @R5  ; IN SWAP BUFFER? BEQ PROT1  ; IFc40 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 dAKE ROOM FOR RETURN STUFF CLR R2 CLR R3 MOV -2(R0),R5  ; SEE IF FS DEVICE MOV 2(R5),R4 BMI DIRFS  ; IT IS DIRNFS: RORB R4 RORB R4   ; OUTPUT BIT SET IN DRVR? BCC .+6   ; NO BIS #5,R3   ; OK FOR OPENC RORB R4 BCC .+6   ; BR IF INPUT BIT OFF BIS #202,R3 BR DIREXIT DIRFS: EMT .LOOKUP   ; CHECK FILE MOV R6,R5   ; CHECK FOR FILE 00.0 TST (R5)+   ; SKIP OVER ADR MOV (R5)+,-(R6) BIS (R5)+,@R6 BIS (R5)+,(R6)+ e;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; RENAME ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; CALLING SEQUENCE ; ; MOV #NEWNAM,-(R6) ; MOV #OLDNAM,-(R6) ; MOV #DATASET,-(R6) ;OLDNAM:FILA ; NAMA ; EXTA ; UIC ;NEWNAM:FILB ; NAMB ; EXTB ; UIC ; PCODE,MODE ;THIS ROUTINE IS THE METHOD BY WHICH A ;PERSON CAN CHANGE HIS PROTECTION CODE ;ERROR REf RESIDENT THEN SKIP MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PUT ADR INTO R3 BNE .+6 JMP PNOBUF  ; TOO BAD MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3  ; FIRST WORD NOW EQ 1 ADD R3,PC  ; GO BABY CLR @R5 CLR -2(R5) PROT1: BIT #200,12(R0) ; CK DATASET BUSY BNE PRER14  ;TOO BAD    ; GET A FIB AND A BUFFER MOV #1,-(R6) EMT .SETUPFIBg .TITLE FCR .GLOBL FCR ; OPENO ; INPUTS ; 2(R0)=NEGATIVE IF THIS IS DT ; WHEN CALLED BY COMMON OPEN PREPROCESSOR THE REGS ARE: ;  R0=ADR DDB ;  R1 POINTS TO THE FIRST ARGUMENT(NOW IN DDB+16)  FIB=R2 OPENO: 177400   ;COMMON CODE TO MOVE CODE    ; FLAG FOR SAM.....NON REENTRANT,0 FCR: ADD PC,R5  ; R5=177776 VIA SAM TST -(R5)  ; LOOK AT FIRST WRD OF CODE MOV (hBEQ DIER15   ; ILLEGAL NAME CMP @R6,#-3 BHIS DIREXIT   ; NO FILE BIS #200,R3   ; SET FILE EXISTS BIT MOV @R6,R5   ; GET ADR FILE ENTRY MOV 10(R5),R4  ; IF USAGE COUNT EQ 76 BIC #177700,R4  ; OR EQ 77, THEN EXIT BEQ DCKTYPE   ; FILE CLOSED BIS #20,R3   ; SET THE FILE OPEN BIT CMP R4,#76   ; CHECK BLO DCKTYPE TST 6(R5)   ; LINKED FILE? BPL DIREX   ; YES BIS #100,R3   ; NO...THEN SET CONTIG BIT BR DIREX DCKTYPEiTURNS: ;  FILA DOESN'T EXIST ;  FILB ALREADY EXISTS ;  FILB IS THE NAME 00.0 RENAME: 177400   ;COMMON CODE TO MOVE CODE    ; FLAG FOR SAM.....NON REENTRANT,0 REN: ADD PC,R5  ; R5=177776 VIA SAM SUB #14,R6  ; DIDDLE STACK FOR LUKUP TST -(R5)  ; LOOK AT FIRST WRD OF CODE TSTB @R5  ; IN SWAP BUFFER? BEQ RENBGIN  ; IF RESIDENT THEN SKIP MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PUT ADR INTO R3 BNEj TST FIBLNK(R0)  ; GET ONE? BEQ PNOBUF MOV -2(R0),R5  ; IMMED EXIT IF NOT FS DEVICE TST 2(R5) BPL PEXIT SUB #14,R6  ; MAKE ROOM FOR ARGS EMT .LOOKUP  ; FILE EXIST? TST @R6  ; BMI PROER2  ;NOPE MOV @R6,R5  ;FILE OPEN MOV 10(R5),R5 BIC #177700,R5 BNE PROER14  ;YUP MOV @R6,R5  ;OK---SET PROTECT BIT BIS #200,20(R5) ADD #14,R6 JSR PC,PROWRIT1 PEXIT: TST FIBLNK(R0)   ; IS THERE A FIB? BEQ .+6    ; NO kR6)+,R0 ; POP STACK INTO R0 MOV (R6)+,R1 ; POP STACK INTO R1.THIS LEAVES    ; 6 WORDS ON STACK FOR LUKUP.    ; NEAT, HUH? TSTB @R5  ; IN SWAP BUFFER? BEQ OPNO  ; IF RESIDENT THEN SKIP MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PUT ADR INTO R3 BEQ NOBUF  ; TOO BAD MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3  ; FIRST WORD NOW EQ 1 ADD R3,PCl: TST 6(R5)   ; TYPE? BMI DCONT   ; CONTIGUOUS BIS #2,R3   ; LINKED...OPENI ALLOWED BIT #300,10(R5)  ; FILE LOCKED? BNE .+6   ; YES BIS #14,R3   ; OPENE AND OPENU ALLOWED BR DIREX DCONT: BIS #100,R3   ; SET CONTIGUOUS BIT BIS #2,R3 BIT #300,10(R5)  ; FILE LOCKED? BNE .+6   ; YES BIS #11,R3   ; OPENU AND OPENC ALLOWED  DIREX: SWAB R3 BISB 20(R5),R3 SWAB R3 MOV 14(R5),R2  ; SET R2=LENGTH DIREXIT: ADD #14m .+6 JMP RENOBUF  ; TOO BAD MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3  ; FIRST WORD NOW EQ 1 ADD R3,PC  ; GO BABY CLR @R5 CLR -2(R5) RENBGIN: BIT #200,12(R0) ; CK DATASET BUSY BNE RENER14  ; WISE GUY MOV #1,-(R6)  ; GET A FIB EMT .SETUPFIB TST FIBLNK(R0)  ; GET ONE? BEQ RENOBUF  ; TOO BAD MOV -2(R0),R5  ; IMMED EXIT IF NOT FS DEV TST 2(R5) BPL RENEXIT EMT .LOOKUP nMOV @PC,-(R6)   ; RLS FIB EMT .RLSFIB CLR @R0    ; RLS DDB MOV @#S.RRES,R5 JSR R5,@R5 MOV (R6)+,2(R6) MOV (R6)+,2(R6) MOV @#S.RSAV,-(R6) JSR R5,@(R6)+ MOV @#S.EXIT,R5  ; SET R5 TO THE ADR OF THE RRES     ; CALL IN THE COMMON EXIT ROUTINE CMP (R5)+,(R5)+ TSTB PROTECT   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #PROTECT-.,@R6 MOV #20,-(R6)  ; o  ; GO BABY CLR @R5 CLR -2(R5) OPNO: MOV 2(R0),R4  ; SET R4 EQ DT INDICATOR MOV FIBLNK(R0),FIB  ; SET R2 EQ ADR FIB EMT .LOOKUP   ; SEE IF FILE EXISTS MOV (R6)+,R5  ;SET R5 EQ RTN ARG FROM LUK     ; IF R5 EQ -1,THEN NO UIC    ; IF R5 EQ -2,THEN NO FILE    ; IF R5 EQ -3,THEN NO UFD.    ; OTHERWISE,THE FILE EXISTS MOV R6,R3  ; CHECK TO SEE IF FILE IS    ; NAMED 00.0 MOV (R3)+,-(R6) BIS (p,R6 DIREX1: MOV R2,20(R6) MOV R3,22(R6) DIRGO: CLR @R0   ; RELEASE DDB TST FIBLNK(R0)  ; IS THERE A FIB? BEQ .+6   ; NO MOV @PC,-(R6)  ; RELEASE FIB AND BUFFER EMT .RLSFIB MOV @#S.EXIT,R5  ; SET R5 TO THE ADR OF THE RRES     ; CALL IN THE COMMON EXIT ROUTINE CMP (R5)+,(R5)+ TSTB DIRS   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #DIRS-.,@R6 MOV #20,-(Rq  ; FILE EXIST? MOV @R6,R4   ; R4=DIR ADR MOV BLOCK(R0),R3  ; R3= BLOCK NUM CMP @R6,#-3   BHIS RENER2   ; FILE DOESN'T EXIST CMP 10(R6),@#UIC  ; CALLER THE OWNER? BNE RENER6   ; NO BIT #77,10(R4)  ; FILE OPEN? BNE RENER14   ; ERRROR IF USAGE COUNT SET TST (R1)+   ; POP R1 SO IT POINTS TO NXT FNB EMT .LOOKUP   ; SEE IF NEW NAME IN USE MOV R6,R5   ; CHECK FOR ILLEGAL FNAME TST (R5)+ MOV (R5)+,-(R6)  ; PUSH NAME ONTrPUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT PROER2: MOV #2,R2 BR PER1Z PRER14: SUB #14,R6  ; DIDDLE STACK    ; DATASET BUSY ERROR PROER14: MOV #14,R2 BR PER1Z PER1Z: TST (R1)+ MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) ADD #14,R6 MOV #ILFSOP,R3 ; SET R3 EQ ERROR CODE BR PER2Z PNOBUF: MOV @R1,R5 MOV #NOBUFR,R3 ; SET R3 EQ ERR CODE PER2Z: MOV -(R5),14(R6) BNE PEXIT   ; EXIT IF NsR3)+,@R6 BIS (R3)+,(R6)+ BEQ ERR15  ; ILLEGAL NAME MOV #-2,R3 CMP R5,R3  ; ARG EQ -2? BEQ SEMPTY  ; IF YES,THEN SEARCH FOR EMPTY SLOT BHI ERR13  ; ERR IF ARG EQ -1 DEC R3 CMP R5,R3  ; IS ARG LOWER THAN -3? BLO ERR2  ; YES....FILE EXISTS    ; OTHERWIS ARG EQ -3.SO,NO UFD    ; THIS CANT HAPPEN ON DT MOV BLOCK(R0),-(R6)  ; SET UP AN MFD ENTRY EMT .GETMAP   ; GETMAP EMT .BALLOC   ; GET A BLK FOR THE UFD MOV (R6)+,BLOCK(R0) t6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT  DIER15: MOV #15,R2   ;; ILLEGAL NAME BR DIERR DIER14: MOV #14,R2 DIERR: TST (R1)+   ; BUMP R1 TO FNB MOV @R1,R5   ; GET ADR ERROR CODE MOVB R2,-(R5)  ; SET ERROR CODE TSTB -(R5)   ; BUMP POINTER MOV #ILFSOP,R4  ; SET R4 EQ ERR CODE BR DIRAT1 DIRNOBUF: DIRRATS: MOV #NOBUFR,R4  ; SET R4 EQ ERR CODE MOV @R1,R5 DIRAT1: MuO SP BIS (R5)+,@R6 BIS (R5)+,(R6)+  ; POP IT OFF BEQ RNER15   ; ILLEGAL NAME CMP @R6,#-3 BHIS REN1   ; ALL SET CMP BLOCK(R0),R3  ; IT IS. SEE IF THE IDIOT BNE RENER2   ; USED THE SAME FILE NAME CMP R4,@R6 BNE RENER2 REN1: CMP 10(R6),@#UIC  ; IS CALLER THE OWNER? BNE RENER6   ; WISE GUY MOV R6,R5   ; FILE NAME LEGAL? TST (R5)+ MOV (R5)+,R2 BIS (R5)+,R2 BIS (R5)+,R2 BEQ RNER15  ; NO MOV R3,BLOCK(R0)  ; RESvON-ZERO ADR MOV @R0,-(R6)  ; OTHERWISE,CALL DIAG PRINT MOV R3,-(R6) IOT  ; FS COMMON READ/WRITE ROUTINE PROWRIT1: MOVB #OUT,R5 BR .+6 PROREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0w ; GET BLK NUM OF MFD JSR PC,OPNOREAD1  ; READ IT MOV @FIB,@MYWORD(R0)  ; SET THE BLK NUM OF THE UFD INTO IT BEQ ERR4   ; ERROR SOMEWHERE JSR PC,OPNOWRIT1  ; NOW WRITE MFD BLOCK MOV @FIB,BLOCK(R0) ; GET SET TO WRITE UFD BLK LATER BR ADDTWO SEMPTY: MOV MYWORD(R0),R5  ; PICK UP BLK NUM OF     ; AN EMPTY SLOT.PUT THERE BY LUK BEQ ADDONE   ; DIDN'T GET ONE,SO ADD BLK MOV R5,BLOCK(R0)  ; SET BLK NUM INTO DDB MOV MINE2(R0),R2  ; SET R2 = ADR ENOV -(R5),14(R6)  ; SET ERR RTN BNE DIRGO   ; BR IF NONZERO ADR MOV @R0,-(R6)  ; OTHERWISE CALL DIAG PRINT MOV R4,-(R6) IOT .END yTORE BLOCK NUM JSR PC,RENREAD1  ; READ THE ORIG BLK TST (R6)+   ; BUMP R6 MOV (R6)+,(R4)+  ; MOVE FIL MOV (R6)+,(R4)+  ; MOVE NAM MOV (R6)+,(R4)+  ; MOVE EXT TST (R6)+ MOV (R6)+,12(R4)  ; MOVE PCODE JSR PC,RENWRITE RENEXIT: TST FIBLNK(R0)  ; IS THERE A FIB? BEQ .+6   ; NO MOV @PC,-(R6)   ; RLS FIB EMT .RLSFIB CLR @R0 CLR BUFADR(R0) MOV @#S.RRES,R5 JSR R5,@R5 MOV (R6)+,4(R6) MOV (R6)+,4(R6) TST (R6)+ MOV @#S.,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-PROTECT .END  ; END OF PRO y1|{TRY JSR PC,OPNOREAD1  ; READ THE BLK WITH A HOLE BR OP03   ; SET UP ENTRY     ; ADD A BLOCK TO DIR THEN ADDONE: MOV R0,R3   ; USE R3 AS POINTER TO DDB CMP (R3)+,(R3)+ TST R4   ; IS THIS A DT? BMI ERR12   ; WHY ME GOD? MOV @R3,-(R6)  ; SAVE BLK NUM OF DIR EMT .GETMAP EMT .BALLOC MOV #1406,R4  ; SET R4 IN CASE NO ROOM TST @FIBLNK(R0) BEQ DTFULL   ; NO MORE BLKS MOV (R6)+,(R3)+  ; READ LAST BLK OF DIR JSR PC,OPNOREAD1 MOV| ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC}RSAV,-(R6) JSR R5,@(R6)+ MOV @#S.EXIT,R5  ; SET R5 TO THE ADR OF THE RRES     ; CALL IN THE COMMON EXIT ROUTINE CMP (R5)+,(R5)+ TSTB RENAME   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #RENAME-.,@R6 MOV #20,-(R6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT RENER2: MOV #2,R2   ; FILE DOESNT EXIST BR RERZ1 ~ ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 F @FIBLNK(R0),@(R3)+ ; LINK IT JSR PC,OPNOWRIT1 MOV @-(R3),-(R3)  ; MOV LINK TO BLOCK(R0) ADDTWO: JSR PC,CLRBUF BR OP03 ERR2: MOV #2,R2   ; FILE ALREADY EXISTS ERR2 ERR3C: TST (R1)+ MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) MOV #BADOPN,R4  ; SET R4 IN CASE 0 RTN ADR BR ERR4B NOBUF: TST (R6)+ ERR4: MOV @R1,R5 MOV #NOBUFR,R4  ; SET R4 IN CASE 0 ERR ADR CLR 6(R0) CLR 26(R0)  ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;; =%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFARENER6: MOV #6,R2   ; IMPROPER ACCESS PRIV BR RERZ1 RENER14: MOV #14,R2   ; ILLEGAL ACTION TO AN OPEN FILE BR RERZ1 RNER15: MOV #15,R2   ; ILLEGAL FILE NAME BR RERZ1 RERZ1: TST (R1)+ MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) MOV #ILFSOP,R3  ; SET ERROR CODE BR RER2Z RENOBUF: MOV #NOBUFR,R3  ; SET ERROR CODE MOV @R1,R5   ; PICK UP LB POINTER RER2Z: ADD #14,R6   ; RESTORE STACK MOV -(R5),14(R6)  ; PUT ERR RETURN ON SP RERZ2: BNE IB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT ABOVE TWO STATMENTS ARE WRONG,BUT ;;;;;;;;;;;;;;;;;;;;;;;;;;;; CORE IS TOO TIGHT TO FIX IT BR ERR4C ERR4B: MOV @PC,-(R6)  ; RLS FIB & BUFFER EMT .RLSFIB ERR4C: CLRB 12(R0)   ; CLR FILE OPEN BIT ADD #12,R6  ; RESTORE STACK MOV -(R5),14(R6) BNE ERR4A   ; CALL DIAG PRINT IF DTFULL: MOV @R0,-(R6)  ; ZERO ERR ADR MOV R4,-(R6)  ; PUSH ERR CODE & CALL PRNT IOT ERR4A: BR OPNOEXIT ERR12: MOV #12,R2 ; DT DIR FULL BR ERR3C ERR13: MOV #13,R2 DR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 RENEXIT   ; EXIT IF NONZERO ADR MOV @R0,-(R6) MOV R3,-(R6)  ; OTHERWISE,CALL DIAG PRINT IOT  ; FS COMMON READ/WRITE ROUTINE RENWRIT1: MOVB #OUT,R5 BR .+6 RENREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS BR ERR3C  ; USER OTHER THAN OWNER ATTEMPTED    ; TO WRITE ON DT ERR15: MOV #15,R2  ; ILLEGAL FILE NAME BR ERR3C OP03: SETENTRY: MOV (R6)+,(R2)+ MOV (R6)+,(R2)+ MOV (R6)+,(R2)+ TST (R6)+ MOV #103,-(R6)  ; GET THE DATE EMT .DATE MOV (R6)+,@R2 ; TYPE/DATE BIC #170000,(R2)+ ;MOV @R6,@R2   ; IMPLEMENT WHEN MODE IS USED ;BIC #170000,@R2 SETHOW: BIS #00077,(R2)+  ; MODE/OPEN SETSTRT: CLR (R2)+ ; S BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE ALO .GLOBL ALO  ; ALLOC FIB =R2 ALLOC: 177400   ;COMMON CODE TO MOVE CODE  BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-RENAME .END  ; END OF REN   ` L`p%DJ._.5 <dvN6Ne& .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE LBA .GLOBL LBA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TART CLR (R2)+ ; LENGTH CLR (R2)+ ; END MOV (R6)+,@R2  ; PROTECT CODE BNE .+6   ; BR IF ZERO.OTHERWISE, MOV #233,@R2  ; SET DEFAULT PROTECT CODE SUB #20,R2 ; RESET R2 TO BEG OF ; DIR ENTRY MOV PC,-(R6)   ; SET UP FIB EMT .SETUPFIB GETONE: EMT .GETMAP   ; CALL LINKED BLK ALLOCATOR EMT .BALLOC GOTIT: MOV FIBLNK(BIBREG),R5 ; SAV STRT   ; FLAG FOR SAM.....NON REENTRANT,0 ALO: ADD PC,R5  ; R5=177776 VIA SAM TST -(R5)  ; LOOK AT FIRST WRD OF CODE TSTB @R5  ; IN SWAP BUFFER? BEQ AOPNO   ; IF RESIDENT THEN SKIP MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PUT ADR INTO R3 BEQ ANOBUF  ; NO BUFFER MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3   ; FIRST WORD NOW EQ 1 ADD R3,PC  ; ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG;;;;;;;;;;; ;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; BLOCK ALLOCATOR ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; PART 1 ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DOG =FIB FIB =R4 BALLOC: 177400 LBA: MOV @R6,R0   ; RESTORE R0 CLR #FTF   ;CLR FIRST TIME FLAGS FTF =.-2 MOV WC(R0),-(R6)  ; SAVE OLD WRD COUNT MOV #177700,IN DIR MOV R5,R3   ; SET R3 EQ ADR OF START ADD #12,R3   ; BLOCK IN THE FIB MOV @R5,12(R2) MOV @R5,(R3)+  ; SAVE START IN FIB MOV TYPE(R5),6(R2) MOV (R3)+,14(R2)  ; SAVE LENGTH MOV (R3)+,16(R2)  ; SAVE LAST SUB (R3)+,R2  ; SUB DIRITM(FIB),R2 MOV R2,BUFADR(BIBREG) MOV (R3)+,BLOCK(R0)  ; GET DIR BLK NUM JSR PC,OPNOWRIT1 MOV @FIBLNK(R0),BLOCK(R0) JSR PC,CLRBUF MOV R2,BUFPTR(R0) OPNOEXIT: MOV #4,R5 ADD @#S.EXIT,R5  ; SET R5 TO THEGO BABY CLR @R5 CLR -(R5) AOPNO: MOV -2(R0),R4  ; IMMED EXIT IF NOT FS DEV TST 2(R4) BMI .+6 JMP AEXIT MOV #1,-(R6)  ; GET A FIB AND A BUFFER EMT .SETUPFIB MOV FIBLNK(R0),FIB BEQ ANOBUF   ; TOO BAD SUB #14,R6   ; MAKE ROOM FOR ARGS EMT .LOOKUP   ; LOOKUP MOV (R6)+,R3 MOV R6,R4   ; CHECK FOR ILLEGAL FNAME MOV (R4)+,R5 ADD (R4)+,R5 ADD (R4)+,R5 BEQ AERR15   ; BLAPPPPPP CMP R3,#-3 BLO AERR3A   ; FILE =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATWC(R0)  ; SET UP FOR 64 WD XFRS AGAIN: MOV FIBLNK(BIBREG),FIB CLR @FIB   ; TO CHECK FOR ERRORS LATER CLR BLKREG MOV CBMPTR(FIB),MAPREG ; GET ADR MAP MOV 2(MAPREG),R5  ;COMPUTE R5=LOBLK     ;R3=HIBLK MOV 4(MAPREG),R3 ASL R3 ASL R3 ASL R3 ASL R3 MOV R3,R4 ADB2: DEC R5 BEQ ADB3 ADD R4,R3 BR ADB2 ADB3: MOV R3,R5 SUB R4,R5 DEC R3 MOV R5,#LOBLK LOBLK=.-2 CMP BLKREG,R5  ;IS BLK IN THIS PBM? BLO NOTHERE   ;IF ADR OF THE RRES CLR @R0     ; CALL IN THE COMMON EXIT ROUTINE TSTB OPENO   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #OPENO-.,@R6 MOV #20,-(R6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT  ; FS COMMON READ/WRITE ROUTINE OPNOWRIT1: MOVB #OUT,R5 BR .+6 OPNOREAD1: MEXISTS ALREADY CMP R3,#-2 BHI AERR3B   ; NO UIC BEQ ASEMPTY MOV BLOCK(R0),-(R6)  ; SET UP AN MFD ENTRY EMT .GETMAP   ; GETMAP EMT .BALLOC   ; GET A BLK FOR THE UFD MOV (R6)+,BLOCK(R0)  ; GET BLK NUM OF MFD BEQ ADTFULL JSR PC,AOPNOREAD1  ; READ IT MOV @R2,@MYWORD(R0)  ; SET THE BLK NUM OF THE UFD INTO IT JSR PC,AOPNOWRIT1  ; NOW WRITE MFD BLOCK MOV @R2,BLOCK(R0) ; GET SET TO READ UFD BLK BR AADDTWO ASEMPTY: MOV MYWORD(R0),R5  ; GPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PRO NOT, THEN SET CMP BLKREG,R3  ;BLOCK TO FIRST BLK BLOS LOOP0     ;DESCRIBED BY THIS MAP NOTHERE:MOV R5,BLKREG    ;LOOP BEGINS HERE LOOP0: MOV FIBLNK(R0),FIB LOOP: MOV BLKREG,R4 ;COMPUTE ADR END OF MAP MOV MAPREG,R3 ;INTO R3 ADD #6,R3  ;COMPUTE ADR BEG MAP INTO R4 ADD 4(MAPREG),R3 ADD 4(MAPREG),R3 LOOP1: SUB LOBLK,R4 ; R5 WAS LOBLOCK. R4 NOW    ; EQUALS A BLOCK IN THE MAP MOV R4,-(R6) ;SAVE R4 BIC #177760,@R6 ASR R4  ;COMPUTE R4 OVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+10 MOV #PARERR,R4 BR DTFULL TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CLRBUF: MOV BUFADR(R0),R4 MOV RET BLK NUM OF EMPTY SLOT BEQ AADDONE   ; TOO BAD.GO GET ONE     ; REMEMBER THAT LUKUP     ; SETS MYWORD AND MINE2 MOV R5,BLOCK(R0)  ; GET THE BLK NUM MOV MINE2(R0),R2  ; SET R2 EQ ADR ENTRY JSR PC,AOPNOREAD1  ; READ IT BR AOP03   ; SET UP AN ENTRY AADDONE: MOV FIBLNK(R0),FIB  ; GET R2 AGAIN MOV @FIB,R1 MOV BLOCK(R0),-(R6)  ; SAVE BLK NUM OF DIR EMT .GETMAP EMT .BALLOC TST @FIB BEQ ADTFULL   ; NO MORE BLKS MOV (R6)+,BLOCK(R0TECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE GMA .GLOBL GMA ; ROUTINE TO GET BIT MAP ; FOR OPEN FUNCTIONS ; CAN BE CORE OR DISK RESIDENT ; CALLING SEQUENCE ; EMT .GETMAP ; USES USER DDB ; RETURNS CBMPTR(FIB)=0 IF ERROR GETMAP: 1774AS AN INDEX ASR R4  ;R4=R4/16 ASR R4 MOV #1,R5  ;MAKE R4 EVEN BIC R5,R4 ADD MAPREG,R4 ;ADD BITMAP ADR TO R4 ADD #10,R4 LOOP2: DEC @R6  ;CONSTRUCT R5 AS THE MASK BMI LOOP3 ASL R5 BR LOOP2 LOOP3: TST (R6)+  ;POP R6 CHECK1: BIT @R4,R5  ;BLOCK FREE? BNE CHECK2  ;NO BIS R5,@R4  ;YES...GRAB IT ADBXIT: MOV BLKREG,@FIBLNK(BIBREG) ;SET NEXT BLOCK IN FIB MOV FIBLNK(BIBREG),FIB MOV (R6)+,WC(R0) 4,R2 TST (R2)+ MOV WC(R0),R5 CLR (R4)+ INC R5 BNE .-4 RTS PC CAT =.-OPENO .END  ; END OF FCR  )  ; READ LAST BLK OF DIR JSR PC,AOPNOREAD1 MOV @FIB,@BUFADR(R0) ; LINK IT JSR PC,AOPNOWRIT1 MOV @FIB,BLOCK(R0) MOV R1,@FIB ; SAVE R1. USED AS A POINTER TO ARGS LATER AADDTWO: JSR PC,ACLRBUF BR AOP03 ADTFULL: MOV #1406,R3  ; SET ERR CODE BR ALDIAG   ; CALL DIAG PRINT AERR3A: MOV #-2,R2   ; FILE ALREADY EXISTS ERR2 AERR3B: NEG R2  ; NO UIC TST (R1)+ MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) MOV #ILFSOP,R3  ; SET ERR CODE ADD #1200   ; FLAG FOR SAM...NON REENTRANT,0 GMA: MOV @R6,R0   ; RESTORE R0 MOV FIBLNK(R0),R5  ; IF THERE ALREADY IS A MAP TST CBMPTR(R5)  ; THEN RETURN BNE GETM4   ; ....THERE IS MOVB DEVNO(BIBREG),R3 BIC #177760,R3 ASL R3 ADD -2(BIBREG),R3 ADD #BMPTR,R3 MOV @R3,R4 BEQ GETM01   ; LINK IN DRIVER EQ 0?     ;NO...IS THIS A DECTAPE? MOV -2(BIBREG),R5 CMP MFDPTR(R5),#DTMFD BEQ GETMERR   ; FILE ALREADY OPEN ON     ; THIS TRANSPOR ; RESTORE ORIG WD CNT ADBX2: MOV @#S.EXIT,R5  ; GET ADR COMMON EXIT TSTB BALLOC  ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC    ;GO SOS GO CHECK2: INC BLKREG  ;CHECK THE REST OF THIS WORD ASL R5 BCC CHECK1 TST (R4)+  ;NONE HERE; POP R4 TRY1: CMP R4,R3  ;PAST END? BHI FIDDLE  ;YUP ADD #20,BLKREG ;NO...LOOK AT NEXT WORD CMP (R4)+,#-1 ;ETC,ETC,ETC BEQ TRY1 SUB #20,BLKREG ; ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIP,R6 BR AERR3C ANOBUF: MOV #NOBUFR,R3 MOV @R1,R5   ; NO BUFFER ERROR AERR3C: MOV -(R5),14(R6) BNE AOPNOEXIT  ; EXIT IF NON-ZERO ADR ALDIAG: MOV @R0,-(R6)  ; OTHERWISE CALL DIAG PRINT MOV R3,-(R6) IOT AERR15: MOV #-15,R2   ; ILLEGAL FILE NAME BR AERR3B AOP03: ASETENTRY: MOV (R6)+,(R2)+ ; FILE MOV (R6)+,(R2)+  ; NAME MOV (R6)+,(R2)+  ; EXT MOV #103,-(R6)  EMT .DATE MOV (R6)+,@R2 ; DATE BIT BR GETM1 GETM01: MOV #4,-(R6)  ; GET A BUF FOR A BIT MAP MOV @#GETBUF,R5 JSR R5,@R5 MOV FIBLNK(BIBREG),FIB ;R4=FIB TOO,SO RESET I MOV (R6)+,CBMPTR(FIB) BEQ GETMNOBUF CLR FLINK(FIB)  ; CLR LINK IN FIB MOV FIB,R5   ; LINK DRIVER TO FIB ADD #FLINK,R5 MOV R5,@R3 MOV -2(BIBREG),R3 MOV MFDPTR(R3),BLOCK(BIBREG) ; GET ADR FIRST BLK MFD MOV BUFADR(R0),-(R6) ; SAVE BUFFER ADDR MOV WC(R0),-(R6)  ; SAVE WC MOV #177700,WC(R0)  ; SETUP FOGOT ONE BR LOOP FIDDLE: MOV BLOCK(BIBREG),-(R6) ;YES...SAVE HIS BIB MOV BUFADR(BIBREG),-(R6) MOV MAPREG,BUFADR(BIBREG) ;SET UP BIB TO    ;WRITE CURRENT BIT MAP MOV 6(MAPREG),BLOCK(BIBREG) ADD 2(MAPREG),BLOCK(BIBREG) DEC BLOCK(BIBREG) JSR PC,ADBWRIT1 TST FTF  ;FIRST TIME? BNE TOP3  ;NO INC FTF  ;    ;YES...GET FIRST MAP NEXT MOV 6(MAPREG),@MAPREG ;READ FIRST BLOCK NEXT TOP3: TST @MAPREG BEMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 C #170000,@R2  ; TYPE BIS #100000,(R2)+ CLR (R2)+   ; USAGE COUNT ASETSTRT: CLR (R2)+ ; START CLR (R2)+ ; LENGTH CLR (R2)+ ; END TST (R6)+   ; SKIP OVER UIC MOVB (R6)+,@R2 ; PROTECT CODE JSR PC,AOPNOWRIT1 ; BECAUSE GETCONTIG USES THE BUFFER MOV PC,R4  ; SET R4 EQ ADR WRITE ROUTINE ADD #AOPNOWRIT1-.,R4 MOV PC,R5  ; SET R5 EQ ADR READ ROUTINE ADD #AR 64 WD XFRS MOV CBMPTR(FIB),BUFADR(BIBREG) JSR PC,GETMREAD1  ; READ FIRST BLOCK OF MFD  MOV BUFADR(BIBREG),R5 ; GET ADR OF MAP.THEN, MOV 2(R5),IF(FIB)  ; SET INTERLEAVE FACTOR INTO FIB MOV 4(R5),BLOCK(BIBREG) ; GET BLK NUM OF FIRST MAP JSR PC,GETMREAD1  ; READ IT MOV (R6)+,WC(R0)  ; RESTORE WC MOV (R6)+,BUFADR(BIBREG) ; RESTORE BUFFER ADR BR GETM3 GETM1: TST @R4  ;LINK 0? BEQ GETM2  ;YES MOV @R4,R4  ;NO---PICK IT UP BR GETM1  ;TRY AQ DISKFULL MOV MAPREG,-(R6) MOV @MAPREG,BLOCK(BIBREG) JSR PC,ADBREAD1 MOV (R6)+,MAPREG  ;RESTORE REGS MOV (R6)+,BUFADR(BIBREG) ;RESTORE HIS BIB MOV (R6)+,BLOCK(BIBREG) JMP AGAIN   ;GO BACK TO BEGINNING     ;AND TRY AGAIN DISKFULL: MOV @R0,-(R6)  ; CALL DIAGNOSTIC PRINT MOV #1406,-(R6) IOT FIB =DOG  ; FS COMMON READ/WRITE ROUTINE ADBWRIT1: MOVB #OUT,R5 BR .+6 ADBREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 OPNOREAD1-.,R5 MOV FIBLNK(R0),R3 MOV R1,(R3)+  ; SAVE R1 MOV BLOCK(R0),(R3)+  ; SAVE BLK NUM OF ENTRY MOV R2,(R3)+   ; SAVE R2...VERY IMPORTANT LATER EMT .GETCONTIG  ; GO GET EM AOPNOEXIT: TST FIBLNK(R0)  ; IS THERE A FIB? BEQ AEXIT MOV @PC,-(R6)  ; RLS THE FIB EMT .RLSFIB AEXIT: CLR @R0 MOV @#S.RRES,-(R6)  ; REMOVE USER CALL ARGS JSR R5,@(R6)+ MOV (R6)+,4(R6) MOV (R6)+,4(R6) TST (R6)+ MOV @#S.RSAV,-(R6) JSR R5,@(R6)+  MOGAIN GETM2: MOV FIBLNK(BIBREG),R5 ;LINK THIS FIB ADD #FLINK,R5 MOV R5,@R4 CLR @R5 MOV -2(R4),-(R5) MOV -4(R4),-(R5) GETM3: CLR @FIBLNK(R0) GETM4: MOV @#S.EXIT,R5  ; GET ADR COMMON EXIT TSTB GETMAP  ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC GETMERR: MOV #-1,@FIBLNK(R0) ; DT UNIT ALREADY HAS A MAP IN CORE BR GETM4 GETMNOBUF: MOV #1,@FIBLNK(R0) ; NO BUFFER RETURN BR GETM4  STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-BALLOC .END  ; END OF LBA DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 V @#S.EXIT,R5  ; SET R5 TO THE ADR OF THE RRES     ; CALL IN THE COMMON EXIT ROUTINE CMP (R5)+,(R5)+ TSTB ALLOC   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #ALLOC-.,@R6 MOV #20,-(R6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT  ; FS COMMON READ/WRITE ROUTINE AOPNOWRIT1: MOVB #OUT,R5 BR .+6 AOPNOREAD1: ; FS COMMON READ/WRITE ROUTINE GETMWRIT1: MOVB #OUT,R5 BR .+6 GETMREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #.TITLE CKX .GLOBL CKX ; THIS ROUTINE IS A UTILITY PROGRAM OF THREE PARTS: ;   CHECK ACCESS PRIVELEGE ;  SETUP FIB ;  RELEASE FIB ; ; TO CALL THE PROGRAM ,PUSH A 0,+1, OR -1 RESPECIVELY ; ONTO THE STACK BEFORE THE EMT CALL IS MADE ;  THE PROGRAM WILL THEN DISPATCH TO THE PROPER SEGMENT ; ; N.B. THE EMT CODES FOR CKACSP,SETUPFIB,AND RELEASEFIB ARE ; THE SAME     ; ROUTINE TO CHECK ACCESS PRIVELEGE    ; INPUTS    ; STACK  MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC ACLRBUF: MOV BUFADR(R0),R4 22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-GETMAP .END  ; END OF GMA  ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V0  ;  RTN ADR    ;  TYPE ACCESS DESIRED    ;  P CODE    ;  UIC    ; OUTPUTS TOP OF STACK    ; 0....OK    ; -1...ERROR    ; CALLED BY JSR PC    ; DESTROYS R5,R3 ; RULES ;  ; OWNER CAN'T WRITE IT BIT 6 IS SET ; ; FRIENDS CAN'T READ IF FRIENDS FIELD IS GT 3 ; ; FRIENDS CAN'T WRITE IF FRIENDS FIELD IS GT 1 ; ; ENEMIES HAVE THE SAME PROBLEM CKACSP: 177400   ; FLAG FOR SAM...NON REENTRANT,0 CKX: MOV @R6,R MOV R4,R2 TST (R2)+ MOV WC(R0),R5 CLR (R4)+ INC R5 BNE .-4 RTS PC CAT =.-ALLOC .END  ; END OF ALL  ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROG00A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAS0   ; RESTORE R0 TST 20(R6)  ; SEE WHY WE ARE HERE BMI TORLSFIB BNE SETUPFIB CMP 26(R6),@#UIC ; CALLER THE OWNER? BNE CKAP1  ; NO CMP 22(R6),#1 ; YES...THEN THE ONLY THING BHI CKAP1  ; HE CAN'T DO IS WRITE ON BIT #100,24(R6) ; HIS FILE IF HE PROTECTED BNE CKERR1  ; HIMSELF BR CKAOK CKAP1: MOV 24(R6),R5 ; P CODE IN R5 MOV 22(R6),R3 ; ACCESS DESIRED IN R3 CMPB 27(R6),@#UIC+1 BEQ CKAPFRND    ; CHECK TO SEE IF ACCESS    ; D ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  RAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGT =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUFESIRED IS LOWER (HIGHER) CKAPWRLD: MOV #177770,-(R6) BR CKAPW1 CKAPFRND: MOV #177707,-(R6) ASL R3 ASL R3 ASL R3 CKAPW1: BIC (R6)+,R5 CMP R3,R5 BLO CKERR1 CKAOK: CLR 26(R6) BR CKOUT CKERR1: MOV #-1,26(R6) CKOUT: MOV @#S.RRES,R5  ; RESTORE REGS JSR R5,@R5 MOV (R6)+,4(R6)  ; MOVE PC DOWN MOV (R6)+,4(R6)  ; MOVE ST DOWN TST (R6)+ CKEXIT: MOV @#S.RSAV,-(R6) ; PUT REGS BACK ON STACK JSR R5,@(R6)+ MOV @#S.EXIT,R5  ; GET ADR CODIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBU=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432MMON EXIT TSTB CKACSP  ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC TORLSFIB: JMP RLSFIB  ;ROUTINE TO SET UP FIB ; WHEN THIS ROUTINE IS CALLED A FIB MAY OR ; MAY NOT BE IN EXISTENCE. IF IT IS,THEN THERE MAY ; ALREADY BE A MAP ASSOCIATED WITH IT. WHEN IT IS ; NECESSARY TO ACTUALLY GET A BUFFER FOR THE FIB,IT ; WILL BE CLEARED. ; IT WILL BE NECESSARY TO GET AIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  F=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UI .TITLE LUK .GLOBL LUK ; THIS ROUTINE IS THE FILE LOOKUP ROUTINE FOR DISK AND ; DECTAPE. CALLING SEQUENCE: ; MOV #FNBADR,-(R6) ; MOV #LNKBLKADR,-(R6) ; MOV @LINKBLK,R0 ; MOV R6,R1 ; SUB #14,R6  ; EMT 46 ; IT IS NECESSARY TO SUB 14 FROM THE STACK BECAUSE LUKUP ; RETURNS ARGUMENTS THERE AS FOLLOWS: ; IF @R6=-1.....THEN NO UIC ; IF @R6=-2 ...THEN NO FILE ; IF @R6=-3.....THEN NO UFD ; IF @R6 EQ ANYTHING ELSE, THEN I BUFFER WHEN CALLED BY DELETE,ETC. ; IT WILL BE NECESSARY TO ACTUALLY SET UP A FIB AND LINK IT ; WHEN CALLED BY OPEN SETUPFIB: MOV FIBLNK(R0),R5  ; CK TO SEE IF ALREADY A FIB BEQ SETUP1   ; NOPE MOV R5,-(R6)  ; YUP BR SETUP2 SETUP1:  ; CODE TO GET A BUFFER,SET AND WC IN DDB AND SET FIB MOV -2(R0),R2 CLR -(R6) MOVB SBS(R2),@R6 MOV #20000,R5 SUB @R6,R5 ASL R5 BCC .-2 MOV R5,WC(R0) INC @R6 MOV @#GETBUF,R5 JSR R5,@R5 MOV (R6)DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TC=440 DAT=432 .TITLE APP .GLOBL APP ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; APPEND ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ; CALLING SEQUENCE:  ; MOV #LB,-(R6)  ; EMT .INIT   ; MOV #FILEA,T POINTS TO THE CORE ADR ; OF THE DIR ENTRY. ;  2(R6)=FIL ;  4(R6)=NAM ;  6(R6)=EXT ;  10(R6)=UIC ;  12(R6)=PCODE ; FUTURE VERSIONS OF THIS ROUTINE WILL MODIFY THE FNB ; THOSE USERS WHO DON'T FEEL LIKE DECODING THE DIR ENTRY ; SHOULD DO A DIRECTORY SEARCH (EMT 14) INSTEAD OF A LUKUP ; EMT44 LOOKUP: 177400   ; FLAG FOR SAM...NON REENTRANT,0 LUK: MOV @R6,R0   ; RESTORE R0 MOV 2(R6),R1 ; WIERD HARLAN CAUSED THIS    ; FIND ORIG R1 +,R5 BEQ SETERR MOV R5,FIBLNK(R0)  ; LINK THE FIB MOV #20,R4 CLR (R5)+   ; CLEAR THE FIB DEC R4 BNE .-4     ; R5 NOW EQUALS ADR OF BUFFER MOV R5,BUFADR(R0)  ; INSERT BUFFER ADR INTO DDB BR SETUPFIB SETUP2: MOV (R6)+,ADR MOV 4(R6),R2  ; WIERD HARLAN STRIKES AGAIN MOV R2,R5  ;GET ADR FILE NAME IN DIR MOV 12(R5),(ADR)+ ;NXT BLK IS THE FIRST TST (ADR)+  ;HOW OPEN INDICATOR ADD #6,R5 CLR (ADR)+  ;NEXT WD IS A SPARE MOV (R5)+,ITLE FCL .GLOBL FCL ; INPUTS 2(R0)=NEGATIVE IF DECTAPE ;  R0=ADR DDB ;  R2=ADR FIB ;  R3=ADR DRIVER ;  R4=HOWOPEN CODE -2 ;  COMMON CLOSE ROUTINE WILL PUT THE ABOVE THINGS ;  INTO THE REGS AND EMT TO FS CLOSE. NOTE THE ;  COOL WAY HE GETS HERE . I.E. BY EXECUTING ;  CODE IN THE DDB ; ;  THIS ROUTINE ASSUMES THAT THE FILE IS OPEN. ;  SUGGEST YOU SAY THREE HAIL MARYS IF IT ISN'T. CLOSE: 177400   ; FLAG FOR SAM...NON REENTR-(R6)  ; MOV #FILEB,-(R6)  ; MOV #LB,-(R6)  ; EMT .APPEND  ; THE ROUTINE WILL THEN APPEND LINKED FILE A T0  ; LINKED FILE B. IF THIS ALSO HAPPENS TO  ; TO BE A DT FILE, THEN ROUTINE AP2 WILL BE  ; CALLED INTO THE SWAP BUFFER TO DIDDLE THE  ; DT BIT MAPS. NOTE THAT IN THE PROCESS OF  ; APPENDING , FILEA CEASES TO EXIST AS A SEPARATE  ; ENTITY...ITS BLOCKS ARE NOW PART OF B. APPEND: 177400   ;COMMON CODE TO MOVE CODE    ; FLAG FOR SAM.....NON REENTRTST (R1)+  ; PUSH F.N.BLK MOV @R1,R5   ; GET THE ADDRESS MOV R6,R2 ADD #22,R2 MOV (R5)+,(R2)+  ; FIL MOV (R5)+,(R2)+  ; NAM MOV (R5)+,(R2)+  ; EXT MOV (R5)+,(R2)+  ; UIC MOV (R5)+,(R2)+  ; P CODE SUB #12,R2 MOV DATPTR(BIBREG),DATREG ; IS THERE AN ASSIGNMENT?  BEQ NONE   ; NOPE CMP (DATREG)+,(DATREG)+ ; GET WD CNT FROM DAT MOVB @DATREG,R5 BEQ NONE   ; IF NONE NO FILE ASS. TST (DATREG)+  ; MOVE TO FILNAM MOV R2,-(R6) @ADR ;TYPE BIC #170000,(ADR)+ MOV (R5)+,(ADR)+ ;SPARE/M/O MOV (R5)+,(ADR)+ ;START MOV (R5)+,(ADR)+ ;LENGTH MOV (R5)+,(ADR)+ ;END MOV R2,@ADR  ;ITEM ADR SUB BUFADR(BIBREG),(ADR)+ MOV BLOCK(BIBREG),(ADR)+ ;BLOCK MOV @R5,@ADR ; PROTECTION CODE SETEXIT: MOV @#S.RRES,R5  ; RESTORE REGS JSR R5,@R5 MOV 2(R6),4(R6)  ; MOVE PC DOWN MOV (R6)+,@R6  ; MOVE STATUS DOWN BR CKEXIT SETERR: CLR FIBLNK(R0) BR SETEXIT ANT,0 FCL: MOV @#S.RRES,R5  ; RESTORE REGS JSR R5,@R5 CMP (R6)+,(R6)+  ; REMOVE ROGERS PC&STATUS     ; ONLY THIN ON STACK NOW IS     ; USER REGS,PC,&STATUS TST R4  ; LOOK AT HOWOPEN CODE-2 BEQ CLDK0   ; OPNEO? DEC R4 BMI CLOSE5   ; BR IF OPENU BNE CLOSE7   ; BR IF OPENI CLOSDK: MOV LAST(FIB),BLOCK(R0) ; DIDDLE FOR LAST BLOCK BCKWRD BPL CL111D BIS #4000,STATUS(R0) NEG BLOCK(R0) CL111D: JSR PC,CLREAD1 MOV BEGEXT(FIB),@BUFADR(ANT,0 APP: ADD PC,R5  ; R5=177776 VIA SAM TST -(R5)  ; LOOK AT FIRST WRD OF CODE TSTB @R5  ; IN SWAP BUFFER? BEQ APPBEG  ; SKIP OVER IF RESIDENT. MOV #20,-(R6) ; DISK RESIDENT. GET A BUFFER MOV @#GETBUF,R4 JSR R5,@R4 MOV (R6)+,R3 ; PUT ADR INTO R3 BNE .+6 JMP APRATS  ; TOO BAD MOV R3,R4  ; LOOP TO DO THE MOVE MOV R5,R2 MOV (R2)+,(R3)+ INC @R4 BLE .-4 SUB R2,R3  ; FIRST WORD NOW EQ 1 ADD R3,PC  ; GO BABY CLR @R5 CLR ; SAVE FOR NOW TST @DATREG   ; FILNAME GIVEN? BEQ LOOK1 CLR 2(R2)   ; IF SO MUST BE 2 WORDS LOOK1: MOV (DATREG)+,R3  ; GET WORD FROM DAT BEQ .+4   ; IF NULL LEAVE ORIGINAL MOV R3,(R2)+  ; OTHERWISE REPLACE DECB R5   ; DONE ALL THERE ARE? BNE LOOK1 MOV (R6)+,R2  ; IF SO RESTORE NONE: TST 6(R2)   ; SET UIC IF NECESSARY BNE NONE0 MOV @#UIC,6(R2) BEQ NOUIC   ; IF UIC ON STACK IS STILL     ; ZERO,THEN HE DIDN'T LOGIN NONE0: ; CODE TO RELEASE A FIB. IT IS QUITE HELPFUL HERE TO KNOW WHAT ; THE HELL IS GOING ON. I WROTE IT ,AND I HAVE A HARD TIME!!!! ; TO START...IN THE DRIVER IS A LIST OF POINTERS TO DDBS. THE LIST ; BEGINS AT DDB+20. THESE POINTERS POINT TO A CHAIN OF FIBS.SO ; -2(R0)=ADR DRIVER ; DRIVER+20+2TIMES THE UNIT IS THE ADR OF THE LIST ; THIS TELLS ALL THE FIBS HAVING A BIT MAP ON THIS DEVICE ; THE FORMAT OF THE FIB IS ; ; FIB+0  NEXT BLOCK ; FIB+2  HOWOPEN CODE ; FIB+4 SPAREBIBREG) JSR PC,CLWRIT1 BIC #4000,STATUS(R0)  ; CLR BCKWRD BIT CLDK0: MOV @FIB,LAST(FIB) ; SET END=LAST BLK WRITTEN MOVB UNIT(R0),R5  ; CALC BM ADR BIC #177760,R5 ASL R5 ADD R5,R3 ADD #BMPTR,R3 MOV FIB,R5 ADD #FLINK,R5 TST 2(R0)  ; ; IS THIS DT? BMI CLOSDT CLDK1: MOV CBMPTR(FIB),MAPREG ;GET SET TO WRITE CBM MOV 6(MAPREG),BLOCK(BIBREG) ADD 2(MAPREG),BLOCK(BIBREG) DEC BLOCK(BIBREG) MOV BUFADR(BIBREG),-(R6) MOV MAPREG,BUFADR( -2(R5) APPBEG: BIT #200,12(R0)  ; SEE IF DATASET BSY BEQ .+6 JMP AP14ER   ; YUP...ERR # 14 MOV #1,-(R6)  ; GET A BUFFER AND A FIB EMT .SETUPFIB TST FIBLNK(R0)  ; GET ONE? BEQ APNOBUF   ; NOPE MOV #20,-(R6)  ; GET A 256 WD BUFFER FOR LATER MOV @#GETBUF,R5 JSR R5,@R5 MOV (R6)+,R5  ; SUCCESSFUL? BEQ APNOBUF   ; NO MOV R5,-(R6)  ; KEEP BUFADR ON STCK MOV -2(R0),R5  ; LOOK IN DRIVMOV R2,R4  ;GO TO NO FILE IF THE MOV (R4)+,-(R6) ;FILE NAME IS 00.0 BIS (R4)+,@R6 BIS @R4,(R6)+ BNE .+6 JMP NOFIL2 MOV -2(BIBREG),R4 MOV MFDPTR(R4),R5  ; GET ADR MFD. THE FOLLOWING    ; SPECIAL CASE LOGIC ELIMINATES TWO    ; DT READS ON MFD#1. FOR THOSE USERS    ; WHO DON'T WANT ANY DT MFD PROTECTION,    ; THE INC R5 INSTRUCTION BELOW SHOULD    ; BE CHANGED TO A CMP (R5)+,(R5)+ CMP R5,#DTMFD BNE .+4 INC R5 MOV R5,BLOCK(R0) THE FIRST BLK OF THE EXT ; FIB+6 TYPE ; FIB+10 ; FIB+12 START BLK ; FIB+14 LENGTH ; FIB+16 LAST ; FIB+20 INDEX INTO THE DIRECTORY BLOCK TO GET ;  THIS ENTRY. ADD THIS NUMBER TO THE CORE ADR ;  OF THE BLOCK TO GET THE ENTRY ; FIB+22 DIRECTORY BLK NUM ; FIB+24 P CODE ; FIB+26 INTERLEAVE FACTOR ; FIB+30 POINTER TO THE BIT MAP ; FIB+32 LINK TO NEXT FIB IN THE CHAIN ; IT IS FIB+32 THAT IS POINTED TO BY THE DRIVER ; ; TO RELEASE A FIB,YOU HAVE TO FIRST CHECK TOBIBREG) CLDK2: CMP R5,@R3  ;SEARCH BIT MAP CHAIN BEQ CLDK3 MOV @R3,R3 BR CLDK2 CLDK3: MOV @R5,@R3  ;REMOVE CHAIN LINK CLDK3A: JSR PC,CLWRIT1  ; WRITE CBM NOW MOV (R6)+,BUFADR(BIBREG) MOV -2(BIBREG),R3 TST BMPTR(R3) ;ARE THERE NO FIBS NOW? BNE CLDK4  ;NO CLDK4A: MOV CBMPTR(FIB),-(R6) ;YES...RELEASE BIT MAP BUF MOV #4,-(R6) MOV @#S.RBUF,R5 JSR R5,@R5 CLDK4: CLOSE5: MOV DIRBLK(FIB),BLOCK(BIBREG) ;UPDATE DIR JSR PC,CLREAD1 MOV BUFAER TO TST 2(R5)   ; SEE IF THIS IS A FS DEV BPL APEX2   ; IMMED EXIT IF NOT CLR R4   ; R4 = FIRST TIME FLG SUB #14,R6   ; MAKE ROOM FOR ARGS APLUP: EMT .LOOKUP   ; SEE IF FILB EXISTS CMP @R6,#-3  BHIS APER2   ; IT DOESN'T MOV @R6,R5   ; CK TO SEE IF CONTIG TST 6(R5)   BMI APER5   ; ERROR BIT #77,10(R5)  ; CK TO SEE IF FILE OPEN BNE APER14   ; ERROR MOV 10(R6),-(R6)  ; CHECK ACCES PRIV...PUSH UIC MOV 14(R6),-(R6 NONE1: JSR PC,LREAD1   ;GET THE MFD CMP BLOCK(BIBREG),MFDPTR(R4) BNE DUN1 MOV @BUFADR(BIBREG),BLOCK(BIBREG) BR NONE1   ; SCAN MFD LOOKING FOR A MATCH ON UIC DUN1: MOVB SBS(R4),R5  ; COMPUTE NUM 4 WD     ; ENTRIES PER MFD BLK BEQ SIZ256 BMI SIZ128 SIZ64: MOV #15,R5 BR DUN2 SIZ128: MOV #31,R5 BR DUN2 SIZ256: MOV #63,R5 DUN2: MOV BUFADR(BIBREG),ADR ; GET ADR BUFFER DUN3: TST (ADR)+    SEE IF IT  ; IS IN THE DRIVER CHAIN.IF IT IS, THEN YOU HAVE TO FIND ; THE FIB IN THE CHAIN THAT POINTS TO THIS FIB+32,AND ; MAKE IT POINT TO THE NEXT FIB IN THE CHAIN RLSFIB: BIT #200,12(R0) ; CHECK TO SEE IF DATASET OPEN BNE SETEXIT  ; SHOULDN'T BE HERE MOV -2(R0),R3  ; R3=ADR DRIVER MOVB UNIT(R0),R5  ; R5=UNIT NUMBER TIMES TWO BIC #177770,R5 ASL R5 ADD R5,R3   ; SET R3=ADR PROPER POINTER ADD #BMPTR,R3 MOV @R3,R4   ; SET R4 =ADR FIRST FIB LINK DR(BIBREG),R5 ADD DIRITM(FIB),R5 ADD #10,R5 MOV @R5,R4 BIT HOWOPEN(FIB),#1  ; CLR LOCK BIT IF THIS BEQ .+6   ; IS OPENE OR OPENU BIC #300,@R5 BIC #77,@R5   ; DEC USAGE COUNT BIC #177700,R4 DEC R4 CMP R4,#76 BNE CLOSE6 CLR R4 CLOSE6: BIS R4,(R5)+ TST (R5)+ MOV LENGTH(FIB),(R5)+ MOV LAST(FIB),(R5)+ JSR PC,CLWRIT1 CLOSE7: MOV FIB,-(R6)  ; RELEASE FIB CLR FIBLNK(R0) MOV #1,-(R6) MOV @#S.RBUF,R5 JSR R5,@R5 M)  ; PUSH PCODE MOV #1,-(R6)  ; PUSH WRITE ACCESS CODE CLR -(R6)   ; SET FLAG EMT .CKACSP   ; CHECK TST (R6)+   ; OK? BNE APER6   ; PROTECTION VIOLATION TST R4   ; FIRST TIME THRU? BNE APCK2   ; NO INC R4 MOV @R6,R3   ; YES... R3=FILB DIR ADR MOV BLOCK(R0),R2  ; SAVE R2= FILB BLK NUM TST (R1)+   ; POP R1 TO NEXT ARG BR APLUP APCK2: CMP @R6,R3   ; CHECK TO SEE IF BOTH FILES BNE APCK3   ; ARE THE SAME CMP B;SKIP OVER LINK SCAN1: CMP (ADR)+,6(R2)  ;HIT?    ; REMEMBER THAT UIC FROM FN BLK    ; IS ON STACK BEQ GOTUIC   ;YES ADD #6,ADR   ;NO...BUMP POINTER DEC R5   ;DEC COUNTER BNE SCAN1   ;KEEP GOING IF MORE MOV @BUFADR(BIBREG),BLOCK(BIBREG) ;GET NEXT BLOCK OF MFD BEQ NOUIC   ;TOO BAD MOV -2(BIBREG),R4 BR NONE1 GOTUIC: TST @ADR  ;UFD IN EXISTENCE? BEQ NOUFD  ;IF NOT NO SCAN! MOV @ADR,BLOBEQ RLSF4 MOV FIBLNK(R0),R5 BEQ RLSF4  ; BR IF NO FIB ADD #FLINK,R5 TST -2(R5)   ; CHECK TO MAKE SURE THAT     ; THE FIB HAS A MAP BEQ RLSF4   ; SKIP IF IT DOESNT RLSF2: CMP R5,R4 BEQ RLSF3 MOV R4,R3 MOV @R4,R4 BR RLSF2 RLSF3: MOV @R5,@R3   ; UNLINK THE FIB  ; IF THERE ARE NO FIBS LEFT IN THE CHAIN THEN RELEASE  ; THE ASSOCIATED MAP. NOTE THAT THE MAP WAS WRITTEN  ; EARLIER,SO NO NEED TO DO IT AGAIN BNE RLSF4  ; MORE FIBS MOOV BUFADR(R0),-(R6)  ; RELEASE BUFFER CLR @R0 MOV -(R0),R1 CLR -(R6)  ; DUMB MACHINE MOVB SBS(R1),@R6 JSR R5,@R5   CLR BUFADR+2(R0) CLOSRTN: MOV @#S.EXIT,R5  ; GET ADR COMMON EXIT TSTB CLOSE   ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC ; DECTAPE CLOSE ; ;   ;DEPENDENT CODE TO UPDATE    ;THE FILE BIT MAP  FIB=R2  FBMWRD=R3  UFDWRD=R4  MAPBLK=R5 ;   ;THLOCK(R0),R2   BEQ APEXIT   ; THEY ARE APCK3: MOV @R6,R1 CLR (R1)+   ; CLR FIL CLR (R1)+   ; CLR NAM CLR (R1)+   ; CLR EXT APWA: JSR PC,APWRIT1  ; WRITE FILA BLK MOV FIBLNK(R0),R4 CMP (R1)+,(R1)+ MOV BLOCK(R0),(R4)+  ; SAVE BLK FILA MOV @R6,(R4)+  ; SAVE DIR ADR FILA MOV (R1)+,(R4)+  ; SAVE START FILA MOV (R1)+,(R4)+  ; SAVE LENGTH FILA MOV (R1)+,(R4)+  ; SAVE END FILA MOV R2,BLOCK(R0) APRDB: JSR PC,APREAD1  ; READ FILCK(BIBREG) ; GET ADR UFD CLR MYWORD(R0)  ; BLK NUM OF AN EMPTY SLOT CLR MINE2(R0)  ; ADR OF AN EMPTY SLOT MOV 2(ADR),-(R6)  ; PUT DIR LENGTH     ; ON STACK. NOTE THAT TOP 3     ; ELEMENTS OF STACK ARE:     ; DIR ENTRY LENGTH     ; THE UIC     ; ADR ON STACK OF FIL GOT1: JSR PC,LREAD1  ;GET FIRST BLOCK UFD BR UFDSCAN   ; NOUFD: MOV #-3,-(R2)  ; NO UFD MOV ADR,MYWORD(R0)  ; SAVE STUFF FOR SETUPMFD ROUTINE BR EXIT NOUIC: V -(R5),-(R6)  ; NO MORE FIBS.GET THE ADR OF THE MAP MOV #4,-(R6)  ; RELEASE IT MOV @#S.RBUF,R5 JSR R5,@R5 RLSF4: MOV BUFADR(R0),-(R6) ; RELEASE THE BUFFER CLR BUFADR(R0)  ; COMPATABILITY IS PAINFUL MOV -2(R0),R5 MOVB SBS(R5),R5 MOV R5,-(R6) MOV @#S.RBUF,R4 JSR R5,@R4  ; RELEASE THE BUFFER MOV FIBLNK(R0),-(R6) ; RELEASE THE FIB CLR FIBLNK(R0) MOV #1,-(R6) JSR R5,@R4 BR SETEXIT CAT =.-CKACSP .END  ; END OF CKX E METHOD IS: ;    READ PBM ;    WRITE CBM AS NEW PBM ;    BIC PBM,CBM ;    READ FBM ;    BIS CBM,FBM ;    WRITE FBM CLOSDT: MOV R3,-(R6)  ; PUSH POINTER. USE IT AT CLDT3 MOV #104,BLOCK(BIBREG) MOV BUFADR(BIBREG),-(R6) ;SAVE BUF ADR JSR PC,CLREAD1 MOV @R3,R1   ; WRITE CBM INTO PBM MOV -(R1),BUFADR(BIBREG) JSR PC, CLWRIT1 MOV #110,R5  ;BIC PBM,CBM MOV @R6,R4 ADD #10,R4 MOV @R1,R1 ADD #10,R1 BB BLK ADD #16,R3  MOV @R3,R1 MOV -(R4),@R3  ; SET NEW END. R1 =OLD END ADD -(R4),-(R3)  ; SET NEW LENGTH JSR PC,APWRIT1 APLNK: MOV -2(R0),R5  ; IS THIS A DT? CLR -(R6) BIT #40000,2(R5) BEQ APLNK2   ; NO COM @R6   ; YES...SET FLG TST R1   ; IS BLK NUM NEG? BPL APLNK2 NEG R1   ; YES...MAKE IT POS BIS #4000,STATUS(R0) ; SET DT REVERSE BIT APLNK2: MOV R1,BLOCK(R0)  ; SET BLK NUM JSR PC,APREAD1  ; READ FILB END MOV MOV #-1,-(R2)  ; PUT THE ERROR ON EXIT: MOV @#S.EXIT,R5  ; GET ADR COMMON EXIT TSTB LOOKUP  ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC   ;SCAN UFD LOOKING FOR FILNAM.EXT UFDSCAN: MOV BUFADR(BIBREG),ADR ; R1=ITEM ADR TST (ADR)+ MOV ADR,R1 UFD1: MOV -2(BIBREG),R5  ; COMPUTE # ENTRIES     ; PER BLOCK OF UFD MOVB SBS(R5),R5 ASL R5 ASL R5 A P ICB (R4)+,(R1)+ DEC R5 BNE .-4 MOV (R6)+,BUFADR(BIBREG) ;RESTORE ORIG BUFADR MOV #70,MAPBLK ;CALCULATE BLOCK + ITEM CMP DIRBLK(FIB),#102 ;OF FBM BEQ .+4 CMP (MAPBLK)+, (MAPBLK)+ MOV #2,UFDWRD CLDT1: CLR FBMWRD CLDT2: CMP UFDWRD,DIRITM(FIB) BEQ CLDT3 ADD #110,FBMWRD CMP FBMWRD,#662 BHI .+10 ADD #22,UFDWRD BR CLDT2 INC MAPBLK BR CLDT1 CLDT3: MOV MAPBLK,BLOCK(BIBREG) ;READ FBM JSR PC,CLREAD1 MOV @R6,R4  ;BIS CBM, FBM M-(R4),@BUFADR(R0) ; LINK IT JSR PC,APWRIT1 BIC #4000,STATUS(R0) ; CLR DT REVERSE BIT TST (R6)+   ; IS THIS A DT? BEQ APEX1   ; NO EMT .APNDP2  ; DIDDLE DT BIT MAPS APEX1: ADD #14,R6   ; RESTORE STACK APEX2: BR APEXIT   ; GO TO EXIT HANDLER APRATS:  APNOBUF: MOV @R1,R5   ; SET R5 EQ ERR ADR MOV #NOBUFR,R3  ; SET R3 EQ CODE CLR -(R6)   ; BECAUSE EXIT EXPECTS IT BR APERX1 APERXIT: MOV #ILFSOP,R3  ; SET R3 EQ CODE ADD #14,SL R5 ASL R5 BNE UFD1A MOV #400,R5 UFD1A: DEC R5 CLR R3 UFD1B: INC R3 SUB @R6,R5 BEQ UFD1C CMP @R6,R5 BLOS UFD1B UFD1C:     ; R3=NUM ENTRIES/BLOCK BR UFD3 UFD2: ADD @R6,R1 ADD @R6,R1 MOV R1,ADR UFD3: TST MYWORD(R0)  ; ALREADY FIND AN EMPTY SLOT? BNE UFD3A  ; YES MOV ADR,R5 MOV (R5)+,-(R6)  ; IS THIS AN EMPTY SLOT? BIS (R5)+,@R6 BIS (R5)+,(R6)+  BNE UFD3A   ; NO MOV BLOCK(R0),MYWORD(R0) ; YES...SAVE BL ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971OV @R4,R4 MOV -(R4),R4 ;SET R4 TO ADR MAP MOV #36.,R5  ;R5=MAP SIZE ADD BUFADR(BIBREG),FBMWRD ADD #10,R4 BIS (R4)+,(FBMWRD)+ ;DO IT DEC R5 BNE .-4 JSR PC,CLWRIT1 ;WRITE THE NEW FBM CLDT4: MOV (R6)+,R3 ;UNLINK THE FIB CLR @R3   ; CLR POINTER TO MAP IN THE DRVR  JMP CLDK4A   ; REJOIN DK CLOSE  ; FS COMMON READ/WRITE ROUTINE CLWRIT1: MOVB #OUT,R5 BR .+6 CLREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUR6   ; RESTORE STACK APERX1: MOV -(R5),16(R6)  ; SET ERR ADR ONTO SP BNE APEXIT   ; BR IF NE APDIAG: MOV @R0,-(R6)  ; TOO BAD...CALL MOV R3,-(R6)  ; DIAG PRNT IOT APER2: MOV #2,R2   ; FILE DOESN'T EXIST BR APERZ APER5: MOV #5,R2 BR APER5   ; ILLEGAL ACTION TO CONTIG FILE APER6: MOV #6,R2 BR APERZ   ; PROTECTION VIOLATION AP14ER: CLR -(R6)   ; BECAUSE EXIT EXPEXTS SUB #14,R6   ; AN ADR OF A BUFFER     ; ILLEGAL ACTION K NUM MOV ADR,MINE2(R0)  ; SAVE THE ADR TOO UFD3A: MOV R2,R5 ;MATCH ON FIRST WORD? CMP (ADR)+,(R5)+ BNE UFD4 CMP (ADR)+,(R5)+ ;MATCH ON SECOND WORD? BNE UFD4 CMP (ADR)+,(R5)+ ;MATCH ON THIRD WORD? BEQ GOTFIL  ;WHOOPPEE UFD4: DEC R3 BNE UFD2 MOV @BUFADR(R0),R5  ; GET NXT BLK BEQ NOFILE   ; END OF CHAIN MOV R5,BLOCK(R0)  ; GO. BR GOT1 GOTFIL: TST (R6)+ MOV R1,-(R2) BR EXIT NOFILE: TST (R6)+ NOFIL2: MOV #-2,-(R2) BR E R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT =.-CLOSE .END  ; END OF FCL x|TO AN OPEN FILE APER14: MOV #14,R2   ; FILE OPEN BR APERZ APERZ: TST (R1)+  ; BUMP R1 TO ADR FNB MOV @R1,R5 MOVB R2,-(R5) TSTB -(R5) BR APERXIT APEXIT: CLR @R0   ; RELEASE DDB TST FIBLNK(R0)  ; IS THERE A FIB? BEQ .+6   ; NO MOV @PC,-(R6)  ; RELEASE FIB AND BUFFER EMT .RLSFIB MOV #20,-(R6)  ; RELEASE THE OTHER BUFFER MOV @#S.RBUF,R5 JSR R5,@R5 MOV @#S.RRES,-(R6)  ; REMOVE USER CALL ARGS JSR R5,@(R6)+ MOV (R6)+XIT  ; FS COMMON READ/WRITE ROUTINE MOVB #OUT,R5 BR .+6 LREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4 BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 ,4(R6) MOV (R6)+,4(R6) TST (R6)+ MOV @#S.RSAV,-(R6) JSR R5,@(R6)+ MOV @#S.EXIT,R5  ; SET R5 TO THE ADR OF THE RRES     ; CALL IN THE COMMON EXIT ROUTINE CMP (R5)+,(R5)+ TSTB APPEND   ; CORE RESIDENT? BNE .+4   ; NOPE MOV R5,PC   ; YUP...GO TO RRES MOV PC,-(R6)  ; PUSH ABS ADR OF THE BUFFER ADD #APPEND-.,@R6 MOV #20,-(R6)  ; PUSH BUF SIZE MOV R5,-(R6)  ; FAKE A JSR TO RBUF MOV @#S.RBUF,PC  ; AND RETURN TO S.EXIT  V @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC CAT= .-LOOKUP .END  ; END OF LUK @ PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMFD=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE  ; FS COMMON READ/WRITE ROUTINE APWRIT1: MOVB #OUT,R5 BR .+6 APREAD1: MOVB #IN,R5 BIC #6,STATUS(R0)  ; CLR OUT FIELD BIS R5,STATUS(R0)  ; SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0)  ; SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . MOV #PARERR,R3  ; SET R3 EQ ERR CODE TST STATUS(R0) ; CRAP OUT ON PARITY ERROR BMI APDIAG   ; BARF TCBA .GLOBL CBA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;CONTIGUOUS BLOCK ALLOCATOR  ; PART 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GETCONTIG: 177400   ; FLAG FOR SAM...NON REENTRANT,0 CBA:  MOV @#S.RRES,R5 JSR R5,@R5 MOV R4,#CBAWRIT1  ; GET THE ADRS OF THE R/W ROUTINES CBA ST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC .END  WRIT1=.-2 MOV R5,#CBAREAD1 CBAREAD1=.-2     ; WHEN POSITION OF THE STACK IS     ; SECURE, THE ABOVE TWO STATEMENTS     ; CAN BE CHANGED MOV -2(R0),R1  ; SET R1 EQ ADR DRVR MOV @FIBLNK(R0),R2 MOV 4(R2),R4  ; NOTE HERE THAT R2 WAS     ; CAREFULLY PRESERVED. BGT LABL CLR R4   ; WHO IS KEN FINE? BR LABL10 LABL: MOVB SBS(R1),R5 ; COMPUTE # WDS REQUIRED CLR -(R6) ASR R5 ASR R5 LABL00: ASR R5 BCS LABL05 ASR R4 BCC LA ;///////////////////////////////////////////// ; ;//////////////////////////////////////////// ; ; ; ;   DISK FILE STRUCTURE PROGRAM ;   V000A ;  DIGITAL EQUIPMENT CORP. ;  COPYRIGHT 1971 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 R6=%6 R7=%BL00 MOV #1,@R6 BR LABL00 LABL05: ADD (R6)+,R4 LABL10: MOV BUFADR(R0),R3 MOV WC(R0),-(R6) MOV #177700,WC(R0)  ; SAVE OLD WD CNT MOV MFDPTR(R1),BLOCK(BIBREG) JSR PC,@CBAREAD1  ;READ MFD BLOCK     ; CALCULATE ADR IN DRVR OF     ; FIB CHAIN,IF ANY. TO SEE     ; IF A BIT MAP IS MOVB UNIT(BIBREG),R5  ; ALREADY IN CORE? ASL R5   ; MULT UNIT NUM BY 2 BIC #177740,R5 ADD #BMPTR,R5  ; ADD OFFSET ADD R1,R5 MOV @R5,R5   ;R5=ADR7 PC=%7 MAPREG =R1 BLKREG =R2 FIB =R2 BIBREG=R0 DRVREG=R5 DATREG=R4 RTMP=R5 ADR=R4 OPNIFLG=4 OPNUFLG =1 OPNEFLG =3 OPNOFLG =2 OPNAFLG =5 OPNCFLG=13 LOGNAM=2 IN=100004 OUT=100002 EOF=20000  ; FIB ASSIGNMENTS NXTBLK =0 HOWOPEN =2 BEGEXT =4 TYPE =6 STRT =12 LENGTH =14 LAST =16 DIRITM =20 DIRBLK =22 IF =26 CBMPTR =30 FLINK =32  ; BIB ASSIGNMENTS UFDPTR =2 MYWORD =2 BLOCK =4  OF POINTER OR 0 BNE CBA1A CLR -(R6) CLR -(R6) BR CBA1 CBA1A: MOV BUFADR(R0),MYWORD(R0)  ; SAVE BUFADR...ALL REGS      ; IN USE,UNFORTUNATELY MOV -(R5),BUFADR(BIBREG)  ; YES...THEN WRITE IT MOV @R5,-(R6)   ; PUSH BUFADR MOV R3,R2 CMP (R2)+,(R2)+  ; LOOK DOWN THE LIST     ; OF MAPS UNTIL YOU FIND     ; THE CURRENT ONE.THEN,     ; WRITE IT AND SAVE ITS     ; CORE ADR AND BLOCK # MOV @R5,R5  ; R5= MAP ADR MOV 2(R5),R1  BUFADR =6 WC =10 STATUS =12 UNIT =13 DEVNO =13 DUNRTN =14 BUFPTR =16 BC =20 CKSUM =22 MINE2 =22 DATPTR =24 FIBLNK =26  ; DRIVER ASSIGNMENTS SBS =4 DSKTFR =10 MFDPTR =16 BMPTR =20 ; OTHER ASSIGNMENTS S.EXIT=42 S.RSAV=44 S.RRES=46 S.CDB=50 S.CDQ=52 GETBUF=54 S.RBUF=56  DKDRVR=1540 DTDRVR=4100 DKFULL =1406 PARERR =1417 BADOPN =1412 NOBUFR =1407 ILFSOP =1423 DFMFD=1 DTMF ; R1 =MAP NUM TIMES 2 ASL R1 ADD R1,R2 MOV @R2,BLOCK(R0) MOV @R2,-(R6)   ; PUSH BLK NUM JSR PC,@CBAWRIT1   ;NOW WRITE IT MOV MYWORD(R0),BUFADR(R0)  ; RESTORE BUFADR CBA1: TST (R3)+   ;READ THE LAST MAP BNE .-2 TST -(R3) MOV -(R3),BLOCK(BIBREG) JSR PC,@CBAREAD1 CLR -(R6)   ; HIGHEST CUNT TO DATE MOV R4,-(R6)   ; NUM NEEDED MOV BUFADR(R0),R1  ; R1=ADR MAP BLK MOV R1,R4   ; SO DOES R4 FOR NOW TST (R4)+ MOV (R4)+,R5 D=100 BCKWRD =4000 ; EMT ASSIGNMENTS .DATE =41 .INIT =6 .RLS =7 .ALLOC =15 .RENAM =20 .APPEND =22 .PROTECT =24 .DELETE =21 .GETMAP =50 .BALLOC =47 .GETCONTIG =51 .LOOKUP =46 .CKACSP =52 .DELNK =53 .DELCONTIG =54 .SETUPFIB =52 .RLSFIB =52 .APNDP2=55 .DIRECT=14 UIC=440 DAT=432 .TITLE AP2 .GLOBL AP2    ;APPEND, PART2 APNDP2: 177400   ; FLAG FOR SAM,...N  ; R5=MAP NUM MOV (R4)+,R3  ; R3=SIZE MOV R4,-(R6)  ; @R6= ADR MAP BLK ASL R3 ASL R3 ASL R3 ASL R3 MOV R3,R2 CBA2: DEC R5 BEQ CBA3 ADD R2,R3 BR CBA2 CBA3: DEC R3   ;R3=HIGHEST BLOCK # IN SYSTEM MOV R4,R2   ; COMPUTE R2=ADR HI WORD ADD -(R4),R2 ADD @R4,R2 CLR R4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;; ON REENTRANT AP2: MOV @#S.RRES,R5 ;RESTORE REGS JSR R5,@R5    ;R0=ADR DDB    ; FIB+0=FILEA BLOCK NUM    ; FIB +2=FILEA ADR    ;R2=FILEB BLOCK NUMBER SUB #14,R3  ;NOW R3=FILB ADR MOV FIBLNK(R0),R4 ;R4=ADR FIB    ;CALCULATE BLOCK & ENTRY OF FBM A MOV 2(R4),-(R6) ; PUSH DIR ADR SUB 6(R0),@R6 ; SUB BUF ADR FROM IT MOV @R4,-(R6) ; PUSH BLOCK NUM FILA JSR PC,CALCFBM  MOV @R6,BLOCK(R0) ;    ; JSR PC,APREAD1 ;READ FBM A MOV B ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;; CONTIG BLK ALLOCATOR ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;; PART 2 ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;AT THIS TIME REGISTER STATUS IS AS FOLLOWS: ; 4(R6) = HIGHEST COUNT TO DATE ; 2(R6) = NUM NEEDED ; @(R6) = ADR-2 OF BOTTOM WORD ; R1 = ADR FIRST WORD OF MAP ; R2 = ADR OF HI WORD ; R3 = HIGH BLOCK # ; R4 = COUNTER ; R5 = MASK CBAP2: CBLUP1: MOV #100000,R5  UFADR(R0),-(R6) ;SAVE FILA BUFADR MOV 26(R6),BUFADR(R0) ;GET BUFADR FILB    ; CALC FBM ADR OF FILB MOV R3,-(R6) ; PUSH ADR FILB ENTRY SUB BUFADR(R0),@R6 ; SUB BUF ADR FILB FROM IT MOV R2,-(R6) ; PUSH BLK NUM FILB JSR PC,CALCFBM MOV @R6,BLOCK(R0) JSR PC,APREAD1 ;READ FBM B    ;BIS FBMA, FBMB    ;CLR FBMA    ;WRITE FBMB MOV 10(R6),R4 ; GET ADR FILEA BUFFER ADD 4(R6),R4 ; ADD FILEA FBM IDX    ; R4 EQ ADR FILEA FBM MOV BUFADR(R0),R3 ;SET MASK CBLOOP: BIT R5,@R2   ;BIT FREE BNE CBAON   ;NO---IT ON INC R4   ;YES---INC COUNT CMP R4,2(R6)  ;COUNT=NUM REQUIRED? BEQ ZONKO NOTYET: DEC R3 CLC    ;NO---SHIFT MASK ROR R5 BNE CBLOOP   ;MASK 0? TST -(R2)   ;YES CMP R2,@R6   ;BOTTOM BNE CBLUP1 BR CBNXT CBAON: CMP R4,4(R6)  ;COMPARE AGAINST PREVIOUS HIGH BLO .+6 MOV R4,4(R6) CLR R4   ;CLEAR COUNTER DEC R3   ; DEC OTHER COUNTER ROR R5   ;RO; GET ADR FILEB BUFFER ADD 2(R6),R3 ; ADD FILEB FBM IDX    ; R3 EQ ADR FILEB FBM MOV #36.,R5  ;MAP = 36 WORDS BIS @R4,(R3)+ CLR (R4)+ DEC R5 BNE .-6 CMP @R6,6(R6) ;FBMA BLK # SAME AS FBMA? BNE APX1  ;NO    ;YES...CLR ENTRY IN FBMB MOV #36.,R5 MOV BUFADR(R0),R4 ;CALC NEW ADR FBMA ADD 10(R6),R4 CLR (R4)+ DEC R5 BNE .-4 APX1: MOV BUFADR(R0),R4 ;SAVE BUFADR MOV 4(R6),BUFADR(R0) ; WRITE BLOCK FBM A MOV 6(R6),BLOCK(R0) TATE MASK BNE CBLOOP CBLUP2: TST -(R2)   ;LOOP HERE, LOOKING FOR A CMP R2,@R6   ;WORD NE -1 BEQ GRUNCH CMP @R2,#-1 BNE CBLUP1 SUB #20,R3 BR CBLUP2 GRUNCH: CBNXT: CMP -4(R2),#1  ; ANY MORE MAPS? BEQ TOOBAD   ; YOU LOSE DEC BLOCK(R0) JSR PC,@CBAREAD1 MOV -2(R2),R5  ;RESET R2 ADD R5,R2 ADD R5,R2 BR CBLUP1 ZONKO: MOV R4,4(R6)  ;HI CNT EQ NUM REQ MOV 4(R1),R1 ASL R1 ADD @R6,R1 TST (R1)+   ; SET R1 = L CMP @R6,6(R6) ;DON'T WRITE IF BOTH SAME BLOCKS BEQ .+6 JSR PC,APWRIT1 MOV R4,BUFADR(R0) MOV @R6,BLOCK(R0) JSR PC,APWRIT1 MOV 4(R6),BUFADR(R0) ;GET ORIG BUFADR APNDEXIT: ADD #12,R6 ; CLEAN UP STACK MOV @#S.RSAV,R5 JSR R5,@R5 MOV @#S.EXIT,R5 ;GET ADR COMMON EXIT TSTB APNDP2  ;SEE IF IN SWAP BUFFER BNE .+4  ;YUP CMP (R5)+,(R5)+ ;NOPE..DON'T DECB MSB+2 MOV R5,PC ;ROUTINE TO CALCULATE BLOCK & ADR OF FAST WRD OF MAP ZONK1: BIS R5,@R2   ;AND MASK ONTO WORD DEC R4   ;DEC COUNT BEQ CBADONE ASL R5 BNE ZONK1   ;MASK EQ 0 TST (R2)+   ;YES---WORD=WORD+2 ZONK2: CMP R2,R1   ;TOO HI? BHIS CBW1 ZONK2A: CMP R4,#20   ;NO---IF COUNT GT 16, THEN SET BHIS ZONK3   ;THE NEXT WORD TO -1, ETC MOV #1,R5  ; RESET MASK BNE ZONK1 ZONK3: MOV #-1,(R2)+ SUB #20,R4 BNE ZONK2 CBW1: JSR PC,@CBAWRIT1  ;WRITE MAP MOV @BUFADR(BIBREG),BLOCK(BIBREG) ILE BIT MAP ;INPUTS   2(R6)=DIR BLOCK ;   4(R6)=IDX INTO DIR ;OUTPUTS  2(R6)=RBM BLOCK ;   4(R6)=FDX INTO FBM ;DESTROYS R4,R5 CALCFBM: CMP 2(R6),#102 BNE .+12 MOV #70,2(R6) BR .+10 MOV #74,2(R6) MOV #2,R5 CALCF1: CLR R4 CALCF2: CMP R5,4(R6) BEQ CALCF3 ADD #22,R5 ADD #110,R4 CMP R4,#662 BLO CALCF2 INC 2(R6) BR CALCF1 CALCF3: MOV R4,4(R6) RTS PC  ; FS COMMON READ/WRITE ROUTINE APWRIT1: MOVB #OUT,R5 BR .+6 APR BEQ CBADUN JSR PC,@CBAREAD1  ;READ NEXT MOV @R6,R2 TST (R2)+   ;WORD=START BR ZONK2A   ;KEEP GOING CBADONE: JSR PC,@CBAWRIT1 CBADUN: MOV FIBLNK(BIBREG),R4 MOV 6(R6),BLOCK(R0)  ; READ BACK ORIG MAP IF ORIG IN CORE MOV 10(R6),BUFADR(R0) BEQ .+6 JSR PC,@CBAREAD1 SUB #6,@R6   ; CALC ADR OF ORIG BUFADR MOV (R6)+,BUFADR(R0) MOV 2(R4),BLOCK(R0) MOV 10(R6),WC(R0)  ; RESTORE ORIG WC JSR PC,@CBAREAD1  ; READ BACK DIR ENTRY BLK MOV 4( EAD1: MOVB #IN,R5 BIC #6,STATUS(R0) ;CLR OUT FIELD BIS R5,STATUS(R0) ;SET FUNC MOV @#S.RSAV,R5 JSR R5,@R5 MOV #10,R1 MOV PC,R5 ADD #20,R5 MOV R5,DUNRTN(R0) ;SET UP FOR BR . MOV @#S.CDB,R5 JSR PC,@R5 BR . TST STATUS(R0) ;CRAP OUT ON PARITY ERROR BPL .+12 MOV @R0,-(R6) MOV #PARERR,-(R6) IOT TST -(R6) MOV @#S.CDQ,R5 JSR PC,@R5 ADD #22,R6 MOV @#S.RRES,R5 JSR R5,@R5 RTS PC #R4),R2 MOV R3,-(R2) ADD @R6,@R2   ; SET LAST BLK DEC @R2 MOV @R6,-(R2)  ; LENGTH MOV R3,-(R2)  ; START JSR PC,@CBAWRIT1  ; NOW WRITE IT CBARTN: MOV R0,-(R6)  ; YUK YUK YUK MOV @#S.EXIT,R5  ; GET ADR COMMON EXIT TSTB GETCONTIG  ; SEE IF IN SWAP BUFFER BNE .+4   ; YUP CMP (R5)+,(R5)+  ; NOPE..DONT DECB MSB+2 MOV R5,PC TOOBAD: MOV FIBLNK(R0),R4 TST (R4)+ MOV (R4)+,BLOCK(R0) MOV 12(R6),W .END   ;END OF AP2 C(R0)  ; RESTORE ORIG WC JSR PC,@CBAREAD1 MOV @R4,R2 SUB #20,R2 CLR (R2)+ CLR (R2)+ CLR (R2)+ BR CBADONE CAT =.-GETCONTIG .END