.TITLE $RD01 ; ; $RD V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $RD,$RC ; $RD THE REAL TO DOUBLE PRECISION CONVERTER ; APPEND ZEROS TO THE TOP STACK ITEM TO ; MAKE IT DOUBLE PRECISION FORMAT ; $RC --- REAL TO COMPLEX CONVERSION ; REPLACES THE REAL ON TOP OF THE STACK WITH ; A COMPLEX NUMBER WHOSE REAL PART IS THE STACK ; ITEM AND WHOSE IMAGINARY PART IS 0. R4=%4 SP=%6 $RC: $RD: MOV 2(SP),-(SP) ;MOVE LOW ORDER PART MOV .TITLE RNDU02 ; ; RANDU V002A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL RANDU ; RANDOM NUMBER GENERATOR ; CALLING SEQUENCE: ; CALL RANDU(I1,I2,J1,J2,R) ; WHERE ; I1,I2 IS THE GENERATOR BASE FOR THIS CALL ; AND SHOULD BE 0,0 FOR THE FIRST CALL ONLY. ; R IS A RANDOM REAL NUMBER UNIFORMALY ; DISTRIBUTED BETWEEN 0. AND 1. ; EXAMPLE: ; . ; . ; CALL RANDU (0,0,R) ; . ; . ; MAKE SOME USE OF R ; . ;1 CALL RANDU (I1,I2,R) ; .TITLE $TSI01 ; ; $TSI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $TSI,$TSR,$TSD ; $TSI,$TSR,$TSD LOGICAL TEST ROUTINES ; CALLED IN THE POLISH MODE ; TESTS THE ITEM ON THE TOP OF THE STACK ; AND RETURNS CONTROL TO THE POINT WHOSE ADDRESS ; IS POINTED TO BY R4 IF <0, BY R4+2 IF =0, AND ; R4+4 IF >0. R4=%4 SP=%6 $TSI: NEG (SP)+ ;TEST INTEGER ITEM BR BGT $TSD: MOV (SP)+,2(SP) ;DOUBLE PRECISION ENTRY TST (SP)+ ;POP .TITLE SIGN01 ; ; SIGN V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL SIGN ; THE FORTRAN SIGN FUNCTION ; CALLING SEQUENCE: ; JSR R5,SIGN ; BR A ; .WORD ADDRESS OF FIRST ARGUMENT ; .WORD ADDRESS OF SECOND ARGUMENT ;A: ; RETURNS SIGN (ARG2) * ABS(ARG1) IN R0, R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SIGN: MOV 2(R5),R1 ;GET FIRST ARG ADDRESS MOV @R1,R0 ;GET FIRST ARG IN R0,R1 MOV 2(R1),R1 MOV @4(R5),R4 ;GET HIGH ORD 2(SP),-(SP) ;MOVE HIGH ORDER PART CLR 4(SP) ;INSERT TRAILING ZEROS CLR 6(SP) JMP @(R4)+ .END . ; USE R ; . ; GO TO 1 ; . R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 RANDU: CMP (R5)+,#403 ;SHOULD BE 3 ARGS BNE ERROR ;JUMP IF NOT 3 MOV (R5)+,R2 ;ADDRESS OF I1 MOV (R5)+,R3 ;ADDRESS OF I2 MOV @R2,R0 ;GET I1 MOV @R3,R1 ;GET I2 BEQ INIT ;JUMP IF INITIAL CALL ASL R1 ;MULT BY 2 ROL R0 ADD @R2,R0 ;NOW BY 3 ADD @R3,R1 ADC R0 ADD @R3,R0 ;NOW BY 2**16 +3 BPL PLUS ;JUMP IF + ADD #100000,R0 ;GET 2**32 +G PLUS: MOV R0, THE STACK OF USELESS INFO. $TSR: MOV (SP)+,(SP) ;REAL ENTRY MOVE HIGH ORDER UP NEG (SP)+ ;DO THE TEST BVS ZERO ;REAL -0 = 0 BGT: BGT NEG ;JUMP IF ARG < 0 BEQ ZERO TST (R4)+ ;ARGUMENT IS POSITIVE, USE THIRD RETURN ZERO: TST (R4)+ ;ARGUMENT IS ZERO, USE SECOND RETURN NEG: MOV (R4),R4 ;GET THE RETURN ADDRESS POINTER JMP @(R4)+ ;EXIT .END ER SECOND ARG ROL R0 ;DUMP FIRST ARG SIGN ROL R4 ;GET SECOND ARG SIGN ROR R0 ;INSERT IN FIRST ARG RTS R5 .END @R2 ;STORE NEXT GENERATOR MOV R1,@R3 MOV #202,R2 ;GET INITIAL EXPONENT NORM: ASL R1 ;FLOAT RESULT ROL R0 BCS EXP ;JUMP IF LEADING BIT FOUND DEC R2 ;COMPENSATE EXPONENT BR NORM EXP: CLRB R1 BISB R0,R1 SWAB R1 CLRB R0 BISB R2,R0 ;INSERT EXPONENT IN RESULT SWAB R0 ROR R0 ROR R1 ;INSERT + SIGN MOV (R5)+,R3 ;ADDRESS OF R MOV R0,(R3)+ ;STORE RESULT FOR USER MOV R1,@R3 RTS R5 ; INIT: MOV #3,R1 INC R0 ;SET UP 2**16 +3 B .TITLE SNGL01 ; ; SNGL V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL SNGL,$ERR ; THE FORTRAN SNGL FUNCTION ; CALLING SEQUENCE: ; JSR R5,SNGL ; BR A ; .WORD ARGUMENT ADDRESS ;A: ; RETURNS THE ARGUMENT ROUNDED TO SINGLE ; PRECISON REAL FORMAT IN R0, R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SNGL: MOV 2(R5),R4 ;GET ADDRESS MOV (R4)+,R0 ;GET HIGH ORDER MOV (R4)+,R1 ;GET LOW ORDER MOV @R4,R4 ;GET NEXT WORD ROL R4R PLUS ; ERROR: HALT TST -(R5) ;BACK UP TO RETURN POINTER RTS R5 .END  .TITLE MIN001 ; ; MIN0 V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL MIN0 ; THE FORTRAN MIN0 FUNCTION ; CALLING SEQUENCE: ; JSR R5,MIN0 ; BR A ; .WORD ADDRESS OF FIRST ARGUMENT ; . ; . ; . ; .WORD ADDRESS OF LAST ARGUMENT ;A: ; RETURNS THE MINIMAL ARGUMENT IN R0. ; R0=%0 R4=%4 R5=%5 MIN0: MOV (R5)+,R4 ;GET NUMBER OF ARGS MIN: MOV @(R5)+,R0 ;GET TRIAL MAX BR LOOP ;GO TEST COUNT COMP: CMP @R5,R0 ;COMP .TITLE MAX001 ; ; MAX0 V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL MAX0 ; THE FORTRAN MAX0 FUNCTION ; CALLING SEQUENCE: ; JSR R5,MAX0 ; BR A ; .WORD ADDRESS OF FIRST ARG ; . ; . ; . ; .WORD ADDRESS OF LAST ARG ;A: ; RETURNS THE MAXIMAL ARGUMENT IN R0. ; R0=%0 R4=%4 R5=%5 MAX0: MOV (R5)+,R4 ;GET NUMBER OF ARGS MAX: MOV @(R5)+,R0 ;GET TRIAL MAX BR LOOP ;GO TEST COUNT COMP: CMP @R5,R0 ;COMPARE NEXT W ;GET ROUND BIT ADC R1 ;ROUND REAL ADC R0 BCS OVER ;JUMP IF OVERFLOW ON ROUND BVS OVER RTS R5 ;RETURN TO CALLER OVER: JSR R5,$ERR ;ERROR 4,12 RTS R5 .BYTE 4 .BYTE 12. .END ARE NEXT WITH SMALLEST SO FAR BLT MIN ;IT IS SMALLER SO SAVE IT TST (R5)+ ;IT LOOSES SO FLUSH IT LOOP: DECB R4 ;CHECK COUNT BGT COMP ;JUMP IF MORE TO COMPARE RTS R5 .END ITH MAX SO FAR BGT MAX ;IT IS BIGGER SO SAVE IT TST (R5)+ ;IT LOOSES SO FLUSH IT LOOP: DECB R4 ;CHECK COUNT BGT COMP ;JUMP IF MORE TO COMPARE RTS R5 .END  .TITLE $MLC01 ; ; $MLC V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $MLC,$MLR,$ADR,$SBR ; COMPLEX MULTIPLICATION. CALLED IN THE POLISH MODE. ; COMPUTES (A+BI)*(C+DI)=(AC-BD)+(AD+BC)I. ; THE STACK CONTAINS: ; D ; C ; B ;@SP A R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 A=4 B=12. C=20. D=20. $MLC: MOV R4,-(SP) ;SAVE RETURN POINTER MOV A(SP),-(SP) ;GET A MOV A(SP),-(SP) MOV D(SP),-( .TITLE ISGN01 ; ; ISIGN V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL ISIGN,$ERR ; THE FORTRAN ISIGN FUNCTION ; CALLING SEQUENCE: ; JSR R5,ISIGN ; .WORD ADDRESS OF ARG1 ; .WORD ADDRESS OF ARG2 ; BR A ;A: ; RETURNS SIGN ARG2 * ABS(ARG1) IN R0. ; R0=%0 R5=%5 ISIGN: MOV @2(R5),R0 ;GET FIRST ARG IN R0 BLE ISN ;GET -ABSOLUTE VALUE NEG R0 ISN: TST @4(R5) ;TEST SIGN OF SECOND ARG BLE RTN ;DONE IF - NEG R0 SP) ;GET D MOV D(SP),-(SP) JSR R4,POLSH .WORD $MLR,MLC1 ;GET A*D MLC1: MOV B(SP),-(SP) ;GET B MOV B(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR R4,POLSH .WORD $MLR,$ADR,MLC2 ;GET AD+BC MLC2: MOV A+0+4(SP),-(SP) ;GET A MOV A+0+4(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR R4,POLSH .WORD $MLR,MLC3 ;GET A*C MLC3: MOV B+0+4(SP),-(SP) ;GET B MOV B+0+4(SP),-(SP) MOV D+0+8.(SP),-(SP) ;GET D MOV D+0+8.(SP),-(SP)  .TITLE IDIM01 ; ; IDIM V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL IDIM,$ERR ; THE FORTRAN IDIM FUNCTION ; CALLING SEQUENCE: ; JSR R5,IDIM ; BR A ; .WORD FIRST ARGUMENT ADDRESS ; .WORD SECOND ARGUMENT ADDRESS ;A: ; RETURNS ARG1-ARG2 IN R0 IF ARG1>ARG2 ; RETURNS 0 OTHERWISE. ; R0=%0 R5=%5 IDIM: MOV @2(R5),R0 ;GET ARG1 SUB @4(R5),R0 ;GET ARG1-ARG2 BVS OVER ;JUMP IF OVERFLOW BGE RTN ;JUMP IF DONE CLR  .TITLE IABS01 ; ; IABS V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL IABS,$ERR ; THE FORTRAN IABS FUNCTION ; CALLING SEQUENCE: ; JSR R5,IABS ; BR A ; .WORD ARGUMENT ADDRESS ;A: ; RETURNS THE ABSOLUTE VALUE OF THE ; ARGUMENT IN R0. ; R0=%0 R5=%5 IABS: MOV @2(R5),R0 ;GET ARG BGE RTN ;JUMP IF + NEG R0 ;MAKE IT + BVS ERROR ;JUMP IF NEGMAX RTN: RTS R5 ERROR: JSR R5,$ERR ;RROR 4,7 RTS R5 .BYTE 4 !;MAKE R0 + BVS ERROR ;JUMP IF NEGMAX RTN: RTS R5 ERROR: JSR R5,$ERR ;ERROR 4,9 RTS R5 .BYTE 4 .BYTE 9. .END " JSR R4,POLSH .WORD $MLR,$SBR,MLC4 ;GET AC-BD MLC4: MOV SP,R0 ;POINT TO RE(RESULT) ADD #18.,R0 MOV (SP)+,(R0)+ ;MOVE RESULT TO RIGHT PLACE MOV (SP)+,(R0)+ MOV (SP)+,(R0)+ MOV (SP)+,(R0)+ MOV (SP)+,R4 ;GET RETURN POINTER ADD #8.,SP ;FLUSH JUNK JMP @(R4)+ ;RETURN TO USER POLSH: TST (SP)+ JMP @(R4)+ .END #R0 ;RETURN 0 RTN: RTS R5 OVER: JSR R5,$ERR ;ERROR 4,8 RTS R5 .BYTE 4 .BYTE 8. .END $ .BYTE 7 .END ) .TITLE $ID01 ; ; $ID V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $ID,$IR ; $ID INTEGER TO DOUBLE PRECISION CONVERSION ; CALLED IN THE POLISH MODE ; REPLACE THE INTEGER ON TOP OF THE STACK ; WITH A DOUBLE PRECISION NUMBER OF EQUAL VALUE SP=%6 $ID: MOV @SP,-(SP) ;PUSH ARGUMENT DOWN MOV @SP,-(SP) CLR 2(SP) ;CLEAR LOWEST ORDER DOUBLE CLR 4(SP) JMP $IR ;GO TO INTEGER TO REAL CONVERT .END * .TITLE DSGN01 ; ; DSIGN V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL DSIGN ; THE FORTRAN DSIGN FUNCTION ; CALLING SEQUENCE: ; JSR R5,DSIGN ; BR A ; .WORD ADDRESS OF FIRST ARGUMENT ; .WORD ADDRESS OF SECOND ARGUMENT ;A: ; RETURNS SIGN ARG2 * ABS(ARG1) IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 DSIGN: MOV 2(R5),R3 ;GET FIRST ARG ADDRESS MOV @R3,R0 ;GET FIRST ARG IN R0-R3 MOV 2(R3),R1 MOV 4(+ .TITLE DABS01 ; ; DABS V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL DABS ; THE FORTRAN ABS FUNCTION ; CALLING SEQUENCE: ; JSR R5,DABS ; BR A ; .WORD ARGUMENT ADDRESS ;A: ; RETURNS THE ABSOLUTE VALUE OF THE ; ARGUMENT IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R5=%5 DABS: MOV 2(R5),R3 ;GET ARG ADDRESS MOV (R3)+,R0 ;GET HIGH ORDER ROL R0 ;DUMP SIGN CLC  ;MAKE IT PLUS ROR R0 MOV (R3)+,R1 ;GET LO, .TITLE DBLE01 ; ; DBLE V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL DBLE ; THE FORTRAN DBLE FUNCTION ; CALLING SEQUENCE: ; JSR R5,DBLE ; BR A ; .WORD ARGUMENT ADDRESS ;A: ; RETURNS THE DOUBLE PRESICION EQUIVALENT ; OF THE REAL ARGUMENT IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R5=%5 DBLE: MOV 2(R5),R2 ;GET ARG ADDRESS MOV (R2)+,R0 ;GET HIGH ORDER MOV @R2,R1 ;GET LOW ORDER CLR R2 ;CLEAR LOWEST ORDER .R3),R2 MOV 6(R3),R3 MOV @4(R5),R4 ;GET HIGH ORDER SECOND ARG ROL R0 ;DUMP FIRST ARG SIGN ROL R4 ;GET SECOND ARG SIGN ROR R0 ;INSERT IT IN FIRST RTS R5 ;RETURN TO CALLER .END /W ORDER PARTS MOV (R3)+,R2 MOV @R3,R3 RTS R5 ;RETURN TO CALLER .END ~ 0CLR R3 RTS R5 ;RETURN TO CALLER .END 1 .TITLE $DR01 ; ; $DR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $DR,$ERR ; $DR THE DOUBLE PRECISION TO REAL CONVERTER ; ROUND THE TOP STACK ITEM TO REAL FORMAT. R4=%4 R5=%5 SP=%6 $DR: ROL 4(SP) ;ROUND LOW ORDER PART ADC 2(SP) ADC @SP BCS OVER ;JUMP IF OVERFLOW BVS OVER DR1: MOV (SP)+,2(SP) ;MOVE HIGHEST ORDER PART MOV (SP)+,2(SP) ;MOVE LOW ORDER REAL JMP @(R4)+ ;RETURN OVER: JSR R5,$ERR ;ERROR 53,23 BR DR2 .BYTE 3 .BYTE 23. DR2: DEC @SP ;UNDO ROUND DEC 2(SP) BR DR1 .END 6 .TITLE $DI01 ; ; $DI V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $DI,$RI ; DOUBLE PRECISION TO INTEGER CONVERSION ; CALLED IN THE POLISH MODE ; REPLACE THE DOUBLE PRECISION NUMBER ON TOP ; OF THE STACK WITH AN INTEGER OF EQUAL ; VALUE, IF POSSIBLE. SP=%6 $DI: MOV (SP)+,2(SP) ;TRUNCATE TO REAL FORMAT MOV (SP)+,2(SP) JMP $RI ;GO TO REAL TO INTEGER CONVERSION .END 7 .TITLE $DVD01 ; ; $DVD V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $DVD,$ERRA ; $DVD --- THE DOUBLE DIVIDE ROUTINE ; CALLED IN THE POLISH MODE ; THE NUMERATOR IS THE SECOND ITEM ON THE STACK ; AND THE DENOMINATOR IS ON TOP. ; TAKES THE QUOTIENT AND PUTS IT ON TOP ; OF THE STACK IN THEIR PLACE R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 D=8. N=16. Q=16. $DVD: MOV R4,-(SP) MOV R5,-(SP) CLR RF .TITLE $DVC01 ; ; $DVC V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $DVC,$ADR,$SBR,$MLR,$DVR,$ERR ; $DVC --- COMPLEX DIVISION. ; CALLED IN THE POLISH MODE. ; REPLACE THE TWO COMPLEX NUMBERS ON THE ; TOP OF THE STACK WITH THEIR QUOTIENT. ;  ; WHEN CALLED THE STACK CONTAINS: ; BI ; A ; DI ;@SP C ; RESULT IS : ; (AC+BD)/(CC+DD) + (BC-AD)/(CC+DD)I R0=%0 R1=%1 R2=%2 R4=%4 R5=%5 SP=%6 A=12. B=20. C=8. E0 CLR R1 CLR R2 CLR R3 CLR -(SP) ASL N+0-2(SP) ;SHIFT NUMERATOR ROL @SP ;GET NUMERATOR SIGN CLR -(SP) BISB N+1(SP),@SP ;GET NUMERATOR EXPONENT BEQ ZERO ;JUMP IF NUMERATOR IS ZERO BISB N(SP),R0 SWAB R0 ;LEFT JUSTIFY NUMERATOR FRACTION SEC  ;INSERT NORMAL BIT ROR R0 BISB N+3(SP),R0 BISB N+2(SP),R1 SWAB R1 BISB N+5(SP),R1 BISB N+4(SP),R2 SWAB R2 BISB N+7(SP),R2 BISB N+6(SP),R3 SWAB R3 ASL D(SP) ;SHIFT DENOMIN"DD "@D" @D "D """@DD@DADDB C>q4d r4dX4d /xO\4d xO4d RO4dQO4d#SX4d"?;O\4d!8V4d#j8{4d$84d%)O\4d&.*{4d'/\$4d(04d-54d26tX4d3 asX4d4ZX4dGSX4dHTX4dW_X4dXd&O4d^fvρ4dco$D߈coB8a ͋,L w6B ` 5 &  }E >u   d5cU@  Y*  & * D &( 5I'4b Q$ BBB"   U@ e  "U%Gef. U U Bb 0 * BIATOR BEQ DCHK ;JUMP IF DIVISOR IS ZERO ADC 2(SP) ;GET RESULT SIGN CLR R4 BISB D+1(SP),R4 ;GET DIVISOR EXPONENT SUB R4,@SP ;SUBTRACT EXPONENTS SWAB D(SP) ;LEFT JUSTIFY DENOMINATOR SEC  ;INSERT NORMAL BIT ROR D(SP) MOVB D+3(SP),D(SP) MOVB D+2(SP),D+3(SP) MOVB D+5(SP),D+2(SP) MOVB D+4(SP),D+5(SP) MOVB D+7(SP),D+4(SP) MOVB D+6(SP),D+7(SP) CLRB D+6(SP) CLR Q(SP) ;CLEAR QUOTIENT CLR Q+2(SP) CLR Q+4(SP) CMP R0,D(SP) ;COMPARE HIGHJD=16. IM=24. RE=12. $DVC: MOV @SP,R0 ;GET C ASL R0 ;GET EXPONENT CLRB R0 MOV 4(SP),R1 ;GET D ASL R1 ;GET EXPONENT CLRB R1 CMP R0,R1 ;GET MAX. EXPONENT BHIS R0HI MOV R1,R0 R0HI: TST R0 BEQ DCHK ;JUMP IF DENOMINATOR 0 SUB #100000,R0 ;DROP EXCESS 128 ASR R0 ;ALIGN MOV #4,R1 ;COUNT ITEMS MOV SP,R2 ;POINT TO C SCALE: SUB R0,(R2)+ ;SCALE ALL EXPONENTS BCS UNDER ;JUMP IF UNDERFLOW BVS UNDER TST (R2)+ ;SKIP LOW ORDER DECK .TITLE $CMR01 ; ; $CMR V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $CMR ; $CMR THE REAL COMPARE ROUTINE. ; CALLED IN THE POLISH MODE WITH THE TWO ; COMPARANDS ON THE STACK: ; FIRST IS AT 4(SP), SECOND IS @SP ; FLUSH THE TWO COMPARANDS AND RETURN ; THE FOLLOWING CONDITION CODES: ; FIRST < SECOND N=1, Z=0 ; FIRST = SECOND N=0, Z=1 ; FIRST > SECOND N=0, Z=0 R0=%0 R1=%1 R2=%2 R4=%4 SP=%6 PC=%7 $CMR: MOV @PC,RL .TITLE $CMD01 ; ; $CMD V001A ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; .CSECT .GLOBL $CMD ; $CMD THE DOUBLE COMPARE ROUTINE. ; CALLED IN THE POLISH MODE WITH THE TWO ; COMPARANDS ON THE STACK: ; FIRST IS AT 8(SP), SECOND IS @SP ; FLUSH THE TWO COMPARANDS AND RETURN ; THE FOLLOWING CONDITION CODES: ; FIRST < SECOND N=1, Z=0 ; FIRST = SECOND N=0, Z=1 ; FIRST > SECOND N=0, Z=0 R0=%0 R1=%1 R2=%2 R4=%4 SP=%6 PC=%7 $CMD: MOV @PCM NUM. AND DEN. BHI DLOW ;JUMP IF DENOMINATOR LOW BLO DHI ;JUMP IF DENOMINATOR HIGH CMP R1,D+2(SP) ;COMPARE LOW ORDER PARTS BHI DLOW BLO DHI CMP R2,D+4(SP) BHI DLOW BLO DHI CMP R3,D+6(SP) BHI DLOW BNE DHI INC @SP ;BUMP EXPONENT CLR R4 BR FLOAT DCHK: MOV #1403,R0 ;ERROR 3,3 BR ECALL UNDER: MOV #4005,R0 ;ERROR 5,8 ECALL: TST -(SP) ;FAKE SIGN ECALL1: JSR R5,$ERRA ZERO: CMP (SP)+,(SP)+ ;FLUSH EXP AND SIGN BR RTN DLOW: RORN: DEC R1 ;COUNT LOOP BGT SCALE BR DIV UNDER: CLR -2(R2) ;SET UNDERFLOW TO 0 CLR (R2)+ BR DEC DCHK: JSR R5,$ERR JMP @(R4)+ .BYTE 3 .BYTE 7 DIV: MOV R4,-(SP) ;SAVE RETURN POINTER MOV A(SP),-(SP) ;GET A MOV A(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR R4,POLSH .WORD $MLR ;GET A*C .WORD MR1,$MLR,$ADR ;GET A*C+B*D .WORD MR2,$MLR ;GET B*C .WORD MR3,$MLR,$SBR ;GET B*C-A*D .WORD MR4,$MLR ;GET C*C .WORD MR5,$MLR,O0 ;GET 00XXXXX XXXX01 IN R0 MOV 4(SP),R1 ;GET HIGH ORDER FIRST ARG BGE FPOS ;JUMP IF FIRST ARG + ASL R0 ;FLAG FIRST ARG - MOV (SP)+,R2 ;GET HIGH SECOND ARG BLT SAME ;JUMP IF BOTH SIGNS - BR NEG ;JUMP IF FIRST - AND SECOND + FPOS: MOV (SP)+,R2 BLT PLS ;JUMP IF FIRST + AND SECOND - SAME: CMP R1,R2 ;COMPARE MAGNITUDES BNE OUT ;JUMP IF DIFFERENT CMP 4(SP),@SP ;COMPARE LOW ORDER BNE OUT ;JUMP IF DIFFERENT CLR R0 ;FLAG = OUT: ROR R0 ;SAVE C BIP,R0 ;GET 00XXXXX XXXX01 IN R0 MOV 8.(SP),R1 ;GET HIGH ORDER FIRST ARG BGE FPOS ;JUMP IF FIRST ARG + ASL R0 ;FLAG FIRST ARG - MOV (SP)+,R2 ;GET HIGH SECOND ARG BLT SAME ;JUMP IF BOTH SIGNS - BR NEG ;JUMP IF FIRST - AND SECOND + FPOS: MOV (SP)+,R2 BLT PLS ;JUMP IF FIRST + AND SECOND - SAME: CMP R1,R2 ;COMPARE MAGNITUDES BNE OUT ;JUMP IF DIFFERENT CMP 8.(SP),@SP BNE OUT CMP 10.(SP),2(SP) BNE OUT CMP 12.(SP),4(SP) BNE OUT CLR R0 ;FQ R0 ;HALVE DENOMINATOR (C=0) ROR R1 ;TO ENSURE THAT N R5. ;INPUT UNDERWAY ALREADY - CHECK FOR SPECIAL CASES: KB.TCU: CMPB @R5,#25  ;INPUT = CTRL/U? BEQ KB.CU  ;YES - REJOIN CTRL/C OP. INCB @R5  ;MAKE RUBOUT GO NEG. CMPB @R5,@R1  ;IF PREV CHAR ALSO R/O, ... BPL .+6  ;BUFFER SHOWS IT, & ... MOVB #134,(R2)+ ;NEG COMPARE MEABEEN MOVED ALONG STRING TO ; BYTE FOLLOWING LAST CHAR OF LOG NAME. THE ; TOP OF THE STACK CONTAINS THE TABLE OF ; POINTERS TO EACH ELEMENT, WITH 0 WHERE NONE ; HAS BEEN FOUND IN THE SCANSION. ; ; ON EXIT TO PART 3, THE POINTERS WILL ; BE REPLACED BY THE ELEMENTS CONVERTED ; TO THEIR FINAL FORM ; .BYTE 0,-1  ;IN USE/NO SHARE SW. ;SET UP FOR CONTROL SUB-ROUTINE: AS.CO: MOV @#V.RRES,-(SP) ;GET CALL REGS FROM STACK JSR R5,@(SP)+ CMP (SP)+,(SP)+ ;IGNORE CALL RETURN MOV  ;DUMP PART II:- DUMP DEVICE DRIVERS: ; ;ON ENTRY:- ; REGISTER CONTENTS ARE IRRELEVANT ; CONTENTS AS AT END OF PART I ARE ON TOP OF STACK ; THESE WILL BE USED TO CONTROL DUMP ACTION ; ON DEVICE, A POINTER TO WHICH IS IN OLD R3 ; ;IF FUNCTION IS NOT POSSIBL .TITLE KBI.MO ;ROUTINE TO PROCESS MODIFY COMMAND: ; ; REQUIRES INPUT OF OCTAL ADDRESS AS PART ;  OF COMMAND STRING ; IF ADDRESS VALID (ON WORD BOUNDARY & WITHIN ;  AVAILABLE CORE), CONTENT IS OUTPUT ;  NS PRINT \ TSTB @R5  ;NOW CHECK FOR RUBOUT ... BMI KB.RO DECB @R5  ;IF NONE, RESTORE INPUT CMPB @R5,#15  ;... & LOOK FOR RETURN BEQ KB.CRN DEC R0 CMP R1,R0  ;ROOM IN BUFFER? BEQ KB.IXT  ;IF NOT IGNORE THIS BYTE ;NORMAL CHARACTER - STORE IN BUFFER: MOVB (R5)+,(R1)+ ;STORE IN INPUT BUFFER KB.CXT: CLRB @R1  ;FOR NO RUBOUT CLEAR NEXT BYTE KB.UXT: MOVB -(R5),(R2)+ ;ECHO CHAR. OR REPLACEMENT KB.RXT: TSTB @R2  ;END OF ECHO BUFFER REACHED? BPL .+4 SP,R0  ;GET BOTTOM OF TABLE ADD #16,R0 JSR R5,AS.CVT ;GO CVT ELEMENTS ;DESPATCH TABLE FOR ELEMENTS: .WORD AS.CVD-AS.CGO ;RAD50 PACK DEVICE .WORD AS.CVU-AS.CGO ;OCTAL CVT DEVICE UNIT .WORD AS.CVF-AS.CGO ;RAD50 PACK FILE (2 WRDS) .WORD AS.CRP-AS.CGO .WORD AS.CRP-AS.CGO ;RAD50 PACK EXTENSION .WORD AS.CVC-AS.CGO ;SPEC. FOR UIC .WORD AS.CDN-AS.CGO ;RAD50 PACK LOG NAME & XIT ;CONTROL SUB-ROUTINE FOR DESPATCH AS REQD. TST E ON DEVICE SPECIFIED, ; ERROR EXIT AS DESCRIBED FOR PART I WILL BE TAKEN ; ;ON SUCCESSFUL COMPLETION, KBI WILL BE RESTORED, ; VIA EMT CALL (R5 CLEARED) ; ;(THIS VERSION ALLOWS LINE PRINTER DUMP ONLY) R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;LINE PRINTER DUMP ROUTINE: DM.LPD: .BYTE 0,-1  ;IN USE/SERIALLY REUSE SWS. MOV @#V.RRES,R5 ;RESTORE REGISTERS JSR R5,@R5 CMP (SP)+,(SP)+ ;CLEAR CALL OFF STACK ADD R3,R4  ;FUNC = WRITE? (R3:=-2) BNE DM.QY2  ;IF NO& RETURN INPUT IS AWAITED FROM OPERATOR ; IF OPERATOR RETURNS CR ONLY NO CHANGE MADE TO ;  THAT CONTENT; IF HOWEVER NEW OCTAL ;  VALUE IS INPUT BEFORE CR, THIS REPLACES ;  ORIGINAL ; INPUT OF NEW VALUE EXPECTS OCTAL DIGITS ONLY BUT THE ;  ROUTINE ALLOWS CTRL/U & RUBOUT ACTION ;  AS IN COMMAND STRING PROPER. NO OTHER ;  CHARACTER (INCL. CTRL/C) WILL HOWEVER ;  BE ACCEPTED. ; THE COMMAND & RETURN INPUT WILL BE IGNORED WITH ;  APPROPRIATE ERROR MESSAGE IF FORMAT INCORRECT ; B CLR @R4  ;IF SO STOP KBD INT FOR NOW CMP (R4)+,(R4)+ ;BUMP HWR PTR ... MOVB (R4)+,(R4)+ ;... TO CHECK PRINTER BUSY BMI KB.PR  ;IF NOT ECHO NOW BR KB.IXT  ;OTHERWISE WAIT ITS INTERRUPT ;CHARACTER DELETION: KB.RO: MOVB -(R1),@R2 ;SET UP DELCHAR ECHO BMI KB.LD  ;IF NONE, TREAT AS ^U INC R2  ; (I.E. INPUT CHAR MOVED) MOVB @R5,@R1  ;SET R/O SWITCH, LEAVING ECHO BR KB.RXT  ;... & EXIT ;END OF INPUT LINE: KB.CRN: MOVB #73,@R1  ;STORE [;] AS STOPPER (R5)+  ;ALLOWS OMISSION IF NO CVT AS.CVT: MOV -(R0),R1 ;GET TABLE ENTRY BEQ .-4  ;IF ZERO TRY AGAIN MOV R0,R4  ;OTHERWISE LOOK FOR ... MOV -(R4),R2 ;...NEXT NON-0 ENTRY BEQ .-2  ;GIVES END OF ELEMENT DEC R2  ;ALLOW FOR DELIMITER CLR @R0  ;EMPTY STORE FOR RESULT MOV #3,R3  ;SET COUNT MOV (R5)+,-(SP) ;SET UP CONVERSION DESPATCH ADD PC,@SP AS.CGO: JSR PC,@(SP)+ ;... & GO DO IT TST R0  ;IF SATISFACTORY ... BNE AS.CVT  ;... GO TO NEXT T,, CANNOT COPE MOV @#V.SVT.,R4 ;SAVE STACK POINTER MOV SP,V.SSP(R4) ;(WILL APPEAR IN DUMP) ;ALL O.K. DO DUMP: MOV R1,-(SP) ;SAVE START ADDRESS BIC #777,R1  ;SIMULATE FULL BLOCK START MOV PC,R4  ;SET UP ADDR OF CO2A SUBR ADD #DM.LOP-.,R4 DM.LLA: MOV #14,R0  ;FORCE FORM FEED DM.LLB: MOV #2230,R3 ;SET CTRL FOR C2OA SUBR MOV R1,R5  ;OUTPUT BLOCK START ADDR JSR PC,DM.LGA ;CONVT OCTAL TO ASCII JSR PC,@R4  ;... & OTH OUTPUT & INPUT WAIT ON FLAG RATHER THAN USE ;  INTERRUPT. ; ON COMPLETION OR RECOGNITION OF ERROR, RECALLS KBL ;  FOR TIDY UP ; ;REGISTER ASSIGNMENTS: R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .BYTE 0,-1  ;IN USE/NO SHARE SW. ;GET ADDRESS FROM COMMAND INPUT & CHECK VALIDITY: KBI.MO: MOV @#V.RRES,-(SP) ;GET BACK KBI REGS. JSR R5,@(SP)+ CMP (SP)+,(SP)+ ;TIDY STACK JSR PC,MO.A2B ;CONVERT ADDRESS TO BINARY BCC MO MOV R5,-(SP) ;SAVE START OF BUFFER CMPB (R5)+,@R1 ;LOOK FOR FIRST [;] BNE .-2  ;... TO REMOVE COMMENT MOV R5,R1  ;HOLD ITS POSITION CMPB -(R5),-(R5) ;AT START OF BUFFER? CMP R5,(SP)+ BEQ KB.LD  ;IF SO OMIT NEXT STEP (*) INC R5  ;BUMP CTRL PTR .... BR KB.LD  ;.. FOR APPROP. EXIT ; (*) MAKES R5 AND R1 UNEQUAL DURING EXIT SEQUENCE & ; THEREFORE FORCES COMMAND MODE TERMINATION. ;PRINTER CALL - CHECK IF MORE TO DO: KBADD #20,SP  ;OTHERWISE SCRAP TABLE CLR R5  ;REJECT COMMAND BY ... INC AS.ND2+4 ;... RECALL KBL BR AS.XT ;GENERAL ROUTINE FOR RAD50 PACK 3 BYTES: AS.CVD: CMP (R4)+,(R4)+ ;USED TO GET NEXT PTR CMP R4,R0  ;IF FILE NEXT, LEAVE PTR ALONE BEQ AS.CRP BHI .+4  ;IF UNIT MUST BUMP CMPB -(R2),-(R2) ;OTHERWISE MUST MOVE BACK INC R2  ;(BECAUSE DELIMITING VARIES) AS.CRP: JSR PC,AS.CGB ;GO GET BYTE ... JSR PC,@(SP)+ ;...&PRINT IT MOV #12,R0  ;FORCE LINE-FEED DM.LLC: MOV #20100,R3 ;RESET CO2A CTRL MOV R1,R5  ;SET LINE ADDR SWAB R5  ;PRINT ONLY LAST 2 DIGITS JSR PC,DM.LGA ;CONVT TO ASCII JSR PC,@R4  ;PRINT : SET BY CO2A SUBR DM.LLD: SWAB R0  ;... & FORCE SPACE DEC R2  ;DONE ALL WORDS REQD? BLT .+10  ;IF SO PAD WITH BLANK CMP R1,@SP  ;REACHED START YET? BHIS DM.LLE  ;IF SO GO PRINT CONTENT INC R2  ;RESTORE WD CNT IF NOT YET U/W CMP (R5)+,(R1)+ ;SET 1 IN.QY2  ;NONE GIVEN IF NO C BIT BIT R0,#1  ;IS IT ON WORD-BOUND? BNE MO.QY2 CMP R0,V.CSA(R3) ;... & WITHIN AVAILABLE MEMORY? BHI MO.QY2 ;IF ADDRESS VALID, PRINT CONTENT: MOV PC,R3  ;SETUP PRINT ROUTINE ADDR. ADD #MO.OP-.,R3 MOV R0,R1  ;PRINT ADDRESS JSR PC,MO.B2A MOVB #57,R2  ;...FOLLOWED BY / JSR PC,@R3 MOV @R0,R1  ;NOW PRINT CONTENT JSR PC,MO.B2A MOV #": ,R2  ;FOLLOWED BY ': ' MO.IP1: JSR PC,@R3  ;ALSO USED FOR CTRL/U ECHO SWAB R.PR: CMPB (R3)+,#15 ;JUST PRINTED RETURN? BEQ KB.EOL CMP R3,R2  ;AT END OF BUFFER IF NOT? BEQ KB.OMT MOVB @R3,@R4  ;NO - DESPATCH NEXT BYTE KB.MOR: MOV #100,-(R4) ;RE-ENABLE INTERRUPT BR KB.IXT KB.EOL: MOVB #12,@R4  ;AT LINE END, GIVE LINE-FEED TST R1  ;ANY INPUT UNDERWAY? BGT KB.CUW  ;IF SO CONTINUE BELOW CLR R1  ;OTHERWISE CLEAR FLAG MOV #100,-(R4) ;... & RE-ENABLE INT. KB.OMT: MOV R0,R2  ;RESET OUTPUT POINTERS MOV R2,R3 INC R2  ; RETURN TO PROCESS BR .-2  ;IF COME BACK, GO AGAIN ;CO-ROUTINE TO PROCESS BYTE: ; GETS BYTE & RETURNS TO CALLER FOR CHECK - ; IF RAD50 RE-ENTERED AT EXIT; IF OCTAL CVT ; AT EXIT + 10 AS.CGB: MOVB (R1)+,R4 ;GET BYTE ... JSR PC,@(SP)+ ;RETURN TO PROCESS ASL @R0  ;FOR RAD50 MULT BY 50 ASL @R0 ASL @R0 ADD @R0,R4 ASL @R0  ;FOR OCTAL CVT, COMPLETE ROT8 ASL @R0 ADD R4,@R0  ;ADD IN NEW BYTE CMP R1,R2  ;LAST VALID BYTE? BNE .+4 CLRB -(R1)  ;IF R5 & BUMP PTR JSR PC,@R4  ;PAD WITH BLANK ROLB R5  ;DONE 7 TIMES? BCC .-4 SWAB R0  ;RESTORE PRINT BYTES BR DM.LLF  ;CONTINUE BELOW DM.LLE: MOV #2230,R3 ;RESET CO2A CTRL MOV (R1)+,R5 ;SET CONTENT IN BUFFER JSR PC,DM.LGA DM.LLF: BIT #17,R1  ;OUTPUT 8 CONTENTS? BNE DM.LLD DM.LLG: JSR PC,@R4  ;PRINT : SET BY CO2A SUBR SWAB R0  ;FOLLOWED BY SPACE MOV R1,R5  ;SAVE POINTER SUB #20,R1  ;GO BACK TO LI2 JSR PC,@R3 ;PROCESS INPUT OF NEW VALUE IF ANY: CLRB @#TKB  ;ENABLE KEYBOARD MO.IP2: MOV R5,R1  ;SET STORAGE POINTER INC R1 MO.IP3: CLRB @R1  ;SHOWS NO RUBOUT SEEN MO.IP4: TSTB @#TKS  ;WAIT FOR INPUT BPL .-4 MOVB @#TKB,@R5 ;STORE CHAR. WHEN IN BICB #200,@R5 ;... LOSING PARITY BIT MOV #"^U,R2  ;PREPARE FOR CTRL/U CMPB @R5,#25  ;... & LOOK FOR IT BEQ MO.IP1  ;PRINT ECHO & START OVER INCB @R5  ;LOOK ... ALLOWING ABOVE CHK MOVB @PC,@#177560 ;ALLOW NEW INPUT KB.IXT: MOV #RTI,KB.BND+4 ;...SET UP NORMAL EXIT BR KB.BND  ;... & TAKE IT ;(THIS METHOD USED TO ALLOW RELEASE OF SWAP BUFFER IN SAFETY!) ; ;COMMAND INPUT IN PROGRESS - CHECK START OR END: KB.CUW: MOVB #56,-(R3) ;SET [.] IN CASE ... CMPB (R5)+,-(R3) ;... LINE JUST STARTING CMP R5,R1 BEQ KB.MOR  ;IF SO CONTINUE MOV #EMT+.KBI,KB.BND+4 ;OTHERWISE SET UP KBI CALL .=.+KBL+376-. KB.BND: V.RRES=46 .KBI=33 KB.I SO, SET FLAG (**) DEC R3  ;DONE 3 BYTES? BNE AS.CGB  ;IF NOT GO FOR NEXT AS.CNX: TST (SP)+  ;WHEN DONE CO-RTN ADDR RUBBISH RTS PC  ;REMOVE BEFORE EXIT ;(**) FOR RAD50 FORCES LEFT-JUSTIFICATION ;ROUTINE TO PROCESS FILE-NAME: AS.CVF: JSR PC,AS.CRP ;GO CONVERT 3 BYTES MOV R1,-2(R0) ;SAVE POINTER FOR 2ND WORD RTS PC  ;ALLOW GEN RTN TO CALL IT ;SPECIAL ROUTINE TO PROCESS U.I.C.: AS.CVC: DEC R2  ;MOVE BACK TO ] CLR -(SP)NE START MOV R0,R3  ;HOLD SPACE FOR OP BELOW TST R2  ;DONE ALL PRINTING REQUESTED? BPL .+6  ;IF NOT SET UP BYTE PRINT ADD R2,R5  ;OTHERWISE ONLY REMAINDER REQD. ADD R2,R5 DM.LLH: JSR PC,@R4  ;PRINT BYTE (OR SPACE) CMP R1,R5  ;AT END YET? BHIS DM.LLJ  ;IF SO GO OUT NOW CMP R1,@SP  ;BEFORE ACTUAL START? BLT DM.LLI  ;IF SO PRINT SPACE MOVB @R1,R0  ;OTHERWISE PRINT BYTE IN ASCII ADD R3,R0  ;(200-237:=300-337 & BIC @PC,R0  ;340-377:=240FOR RUBOUT CMPB @R5,@R1  ;IF SEEN BEFORE ... BPL .+10  ;SWITCH SET IN BUFFER... MOVB #134,R2  ;& NEG MEANS PRINT \ JSR PC,@R3 TSTB @R5  ;IF RUBOUT THIS TIME ... BPL MO.IP5 MOVB -1(R1),R2 ;ECHO ERASED CHAR. BMI MO.IP4  ;... UNLESS NO MORE THERE JSR PC,@R3 MOVB @R5,-(R1) ;REPLACE WITH R/O[+1] AS SW. BR MO.IP4 MO.IP5: DECB @R5  ;IF NOT R/O, RESTORE CHAR. MOVB @R5,(R1)+ ;... STORE IT, MOVB @R5,R2  ;... & ECHO IT JSR PC,@R3 CMPB R2BS=346-237 .END  ;SET STORE ON STACK TOP AS.CVA: JSR PC,AS.CUS ;GET GROUP CODE TST R0  ;LOOK FOR ERROR BEQ AS.CNX  ;REJECT COMMAND IF ANY INCB @R0  ;ALSO CHECK AGAIN ... BEQ AS.CER  ;... FOR TOO BIG (377) DECB @R0  ;... OR ZERO BEQ AS.CER TST @SP  ;DONE TWO BYTES? BNE AS.CVO  ;IF SO THAT'S IT CMPB (R1)+,#', ;LOOK FOR SEPARATOR BNE AS.CER  ;IF NOT THERE IT'S AN ERROR MOVB @R0,1(SP) ;OTHERWISE STORE GROUP BYTE CLR @R0  ;RESET STORE MOV #3,R3  -277) ADD R3,R0 DM.LLI: INC R1  ;BUMP POINTER BR DM.LLH  ;GO BACK TO PRINT & GET NEXT DM.LLJ: MOV #12,R0  ;SET UP PRINT LINE-FEED TST R2  ;FINISHED YET? BLE DM.LOD  ;IF SO GO OUT NOW BIT #77,R1  ;DONE 8 LINES? BNE DM.LLC JSR PC,@R4  ;IF SO PRINT L/F NOW ... BIT #777,R1  ;DONE PAGE YET? BNE DM.LLB  ;NO - OUTPUT LINE FEED ONLY MOVB @#TKB,R5 ;KEYBOARD STRIKE? BICB #225,R5  ;LOOK FOR ^U BNE DM.LLA  ;IF NOT ^U CONTINUE DM.LOD: CMP ,#15  ;WAS IT RETURN? BNE MO.IP3  ;IF NOT GO BACK FOR MORE ;INPUT DONE - CONVERT & STORE: MOVB #12,R2  ;OTHERWISE FOLLOW WITH LF JSR PC,@R3 INC R5  ;NOW CONVERT TO BINARY MOV R0,R3  ;... SAVING ADDRESS JSR PC,MO.A2B BCC .+4  ;IF NO VALUE GIVEN EXIT MOV R0,@R3  ;OTHERWISE STORE INPUT MOV R1,R0  ;ENSURE R0 NON-0 BR MO.XT  ;... & THEN EXIT ;ROUTINE TO CONVERT INPUT TO BINARY: ; CALLED BY [JSR PC,MO.A2B] WIT;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ;VERSION NUMBER: V000A ;... & COUNT BR AS.CVA  ;GO FOR USER BYTE AS.CVO: ADD (SP)+,@R0 ;COMBINE TWO CODES WHEN DONE RTS PC  ;.... & EXIT ;ROUTINE TO PROCESS DEVICE UNIT NO.: AS.CVU: TST (R4)+  ;IF NOT FOLLOWED BY FILE ... CMP R4,R0 BEQ .+4 DEC R2  ;... MUST ALLOW 2ND DELIMITER ;GENERAL ROUTINE TO CVT 3 OCTAL DIGITS TO BYTE: AS.CUS: JSR PC,AS.CGB ;CALL CO-ROUTINE FOR DIGIT BR AS.CVN  ;GO CHECK VALIDITY AS.CUG: ASL @R0  ;IF VALID DO FIRST ROT8 ADD #10,@SP  ;RECALL CO-RTN F(R0)+,(SP)+ ;MAKE LINEFEED FORMFEED JSR PC,@R4  ;...& PRINT IT BR DM.GXT  ;TAKE COMMON EXIT ;OCTAL TO ASCII CONVERSION: DM.LGA: JSR PC,@R4  ;PRINT CHAR IN R0 MOV R3,R0  ;NOW SET WITH CTRL WORD DM.LGL: ASL R5  ;GET BIT FROM NUMBER ... ROLB R0  ;.. & MOVE INTO PRINT BYTE BCC DM.LGL  ;MARKER BIT OUT AT FRONT? JSR PC,@R4  ;IF SO DIGIT DONE - PRINT CLRB R0  ;RESET MARKER & ASCII BITS BISB #23,R0 ASL R0  ;DOH R5 AT START OF ASCII ; RETURNS WITH VALUE IN R0 IF ANY AT CALL+4; IF NONE ;  AT CALL+2 MO.A2B: CLR R0  ;USED TO STORE VALUE CLRB @R1  ;SWITCH FOR NO INPUT MO.ABG: MOVB (R5)+,R2 ;GET INPUT BYTE CMP R5,R1  ;NOW AT END? BEQ MO.ABD  ;IF SO THAT'S IT CMPB R2,#40  ;SIMILARLY FOR SPACE BEQ MO.ABD SUB #60,R2  ;REMOVE ASCII GARBAGE CMPB R2,#7  ;... & OCTAL DIGIT REMAINS BHI MO.QY1  ;ERROR IF NOT BIT R0,#160000 ;ROOM FOR ANOTHER DIGIT? BNE MO.QY ; TIMER KEYBOARD RESPONSE PROGRAM ; EXPECTS THE KEOR REST JSR PC,@(SP)+ BEQ AS.CNX  ;IF NO NEW BYTE, NO MORE AS.CVN: BIT #340,@R0 ;ROOM FOR THIS BYTE? BNE AS.CER  ;IF NOT, THAT'S IT SUB #60,R4  ;OCTAL DIGIT? CMPB R4,#7 BLOS AS.CUG  ;IF SO BUILD IN DEC R1  ;OTHERWISE GO BACK TST 4(SP)  ;IF FIRST BYTE OF UIC BEQ AS.CNX  ;... COULD BE , - CHK AS.CER: CLR R0  ;IF NOT, ERROR ALSO BR AS.CNX  ;SET FLAG & EXIT ;LOG NAME PROCESSING: AS.CDN: JSR PC,AS.CRNE ALL DIGITS? BCC DM.LGL MOV #20072,R0 ;PREP PRINT SPACE & : RTS PC  ;... & EXIT ;PRINT CHARACTER SUBROUTINE: DM.LOP: MOV @#LPS,-(SP) ;PRINTER AVAILABLE? BMI DM.LER  ;IF NOT IGNORE REQUEST TSTB (SP)+  ;IS IT FREE? BPL DM.LOP  ;IF NOT TRY AGAIN MOVB R0,@#LPB ;OTHERWISE OUTPUT CHAR RTS PC  ;EXIT FOR NEXT ;LINE PRINTER ERROR: DM.LER: MOV @#V.SVT.,R5 ;CLEAN UP STACK MOV V.SSP(R5),SP ;ERROR IN FUNCTION: DM.QY21  ;ALSO ERROR IF NOT INCB @R1  ;SHOW VALID INPUT ASL R0  ;SHIFT PREVIOUS INPUT ASL R0 ASL R0 BISB R2,R0  ;ADD IN NEW DIGIT BR MO.ABG  ;... & TRY AGAIN MO.ABD: TSTB @R1  ;WHEN DONE, CHECK IF ANY VALUE BEQ .+4 261   ;SET C BIT IF SO RTS PC ;ROUTINE TO CONVERT BINARY TO ASCII & PRINT: ; CALLED BY [JSR PC,MO.B2A] WITH VALUE IN R1 ; RETURNS ON COMPLETION WITH R1 CLEAR MO.B2A: MOV #2230,R2 ;SET ROTATION COUNTYBOARD COMMAND: ; TIME [HH:MM:SS] ; THE STATED TIME IS ENTERED INTO THE TIME CELLS ; OTHERWISE THOSE CELLS ARE TYPED (IN THE SAME FORMAT) .TITLE KBI.TI R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .BYTE 0,-1 TIME: MOV @#S.RRES,-(SP)  ; RESTORE REGS JSR R5,@(SP)+ CMP (SP)+,(SP)+ CMPB @R5,-(R1)  ; INPUT ? BEQ T.NOAG   ; NO ; INPUT TIME TO SVT (BUILD IN R0) MOV PC,R3 ADD #TI.DPT-.,R3 ; ADDRESS OF DOUBLE P-2 ;RAD50 PACK NAME CMP (SP)+,(SP)+ ;ON RETURN TIDY STACK MOV AS.CO-4,R0 ;GET PART 3 BLOCK ADD #KBI.OS,R0 BR AS.ND2  ;... & GO GET IT ;ERROR EXIT: AS.XT: MOV #177566,R4 ;RESET TPB POINTER .=.+AS.CO+376-. AS.ND2=. V.RRES=46 .=.+AS.CO-2+KBI.OZ-. .EOT : CLR @SP  ;MAKE OLD R0 SHOW ERROR ;COMMON EXIT: DM.GXT: MOV @#V.RRES,R5 ;RESTORE KBI CALL REGS. JSR R5,@R5 CMP (SP)+,(SP)+ ;CLEAR DUMP CALL FROM STACK CLR R5  ;SHOW KBI NO ACTION INC DML.CR+4 ;RECALL KBI ;MISCELLANEOUS DEFINITIONS: V.SVT.=40 V.RRES=46 V.SSP=52 TKB=177562 LPS=177514 LPB=177516 .=.+DM.LPD+400-. DML.CR: .=.+DM.LPD+KBI.OZ-. .EOT ER MO.BAG: ASL R1  ;GET BIT FROM NO ROLB R2  ;... & MOVE INTO DIGIT BCC .-4  ;...UNTIL BUILT JSR PC,@R3  ;OUTPUT TO PRINTER CLRB R2  ;RESET ROTATION COUNT BISB #23,R2 ASL R2  ;NOW CHECK IF ALL DONE BCC MO.BAG RTS PC  ;IF SO EXIT ;GENERAL PRINT ONE CHARACTER: ; CALLED BY [JSR PC,@R3] WHERE R3 PTS TO MO.OP & ;  R4 POINTS TO TPB. MO.OP: TSTB -2(R4)  ;CHECK IF PRINTER FREE BPL .-4 MOVB R2,@R4  ;IF SO DESPATCH BYTE RTS PC  ;... & EXIT PRECISION CLR (R3)+  ; TIME--CLEAR IT CLR (R3) TI.ALP: CMP (R3)+,(R3)+ ; PROPER MULTIPLIER JSR PC,TI.GET  ; GET HOURS AND MAKE TICKS TST R0 BEQ TI.MNX TI.HLP: ADD @R3,TI.DPT+2 ;DOUBLE PRECISION ADD HOURS BVC TI.HPA INC TI.DPT BIC #100000,TI.DPT+2 TI.HPA: ADD -2(R3),TI.DPT DEC R0   ; EACH HOUR BNE TI.HLP TI.MNX: CMP @R3,#60.  ; END ? BNE TI.ALP  ; NO KEEP BULIDING TI.TCP: MOV @#SVT.,R0  ; PLACE IN SVT MOV TI.DPT,TOD(R0) MOV;ASSIGN PROCESSOR PART 3 ; ; A) FOR COMMAND WITH ARGUMENTS SETS UP TABLE ; ENTRY AS STORED ON TOP OF THE STACK (R2 POINTING ; AT ;EXIT SEQUENCE: .=.+KBI.MO+376-12-. MO.QY1: TST (SP)+  ;ERROR EXIT FROM A2B SUB MO.QY2: CLR R0  ;ALSO ERROR: SET FLAG FOR KBL MO.XT: CLR R5  ;SET DONE FLAG FOR KBL INCB MO.ND+4  ;SET UP KBL RECALL MO.ND:    ;DROPS THRU TO EXIT IN RESMON .=.+KBI.MO-2+KBI.OZ-. V.RRES=46 V.CSA=4 TKS=177560 TKB=177562 .END TI.DPT+2,TOD+2(R0) TI.XIT: CLR R5  ; EXIT INC TI.ND+4 BR TI.ND T.NOAG: MOV TIME-4,R0 ADD #KBI.OS,R0 BR TI.ND ; TTY WAIT ROUTINE TI.TWT: BIT #200,@#TI.TPS BEQ TI.TWT RTS R5 ; PARSE ROUTINE RETURNS INTEGER IN R0 TI.GET: CLR R0 MOV R2,TI.TMP TI.CTT: CMPB @R5,#72   ; COLON ? BEQ TI.COL CMP R1,R5 BEQ TI.IND ASL R0   ; TIMES 2 MOV R0,R2   ASL R0   ; TIMES 4 ASL R0   ; TIMES 8  BOTTOM):- ;  1) AT THE TOP OF FREE CORE IF USER PROGRAM ; IS NOT UNDERWAY. TABLE AREA CLAIMED IS INCLUDED ; WITHIN THE THEN RESIDENT MONITOR ;  2) IF USER PROGRAM HAS BEEN STARTED, CLAIMS ; BUFFER FOR NEW ENTRY. ; (OTHER ENTRIES FOR SAME LOG NAME WILL BE DELETED) ; ; B) FOR COMMAND WITH NO ARGUMENTS, REMOVES ALL ; EXTANT TABLE ENTRIES. (ACCEPTABLE ONLY IF NO USER ; PROGRAM IS RESIDENT IN CORE. ; .BYTE 0,-1  ;IN USE/NO SHARE SW. ;SET UP & CHECK TYPE OF OPERATION: AS.DO: ;DUMMY BLOCKS FOR OTHER DEVICES: ; WILL CAUSE ERROR RETURN! R5=%5 SP=%6 DM.IXT: .BYTE 0,-1  ;IN USE/ERROR SWITCHES MOV @#V.RRES,R5 ;RESTORE REGISTERS JSR R5,@R5 CMP (SP)+,(SP)+ ;CLEAR CALL OFF STACK CLR @SP  ;SET ERROR INDICATOR MOV @#V.RRES,R5 ;RESTORE REGS FOR KBD. JSR R5,@R5 CLR R5  ;SET KBI NO ACTION CMP (SP)+,(SP)+ ;CLEAR DUMP CALL OFF STACK INC DM.IR+4  ;RECALL KBI BR DM.IR V.RRES=46 .=.+DM.IXT+400-. DM.IR: .=.+DM.IXT+KBI.OZ-. ADD R2,R0   ; TIMES 10 CLR R2 BISB (R5)+,R2 SUB #60,R2  ; CONVERT FROM ASCII ADD R2,R0 BR TI.CTT TI.COL: INC R5   ; NEXT CHAR MOV TI.TMP,R2  ; RESTORE R2 TI.IND: RTS PC SVT.=40 TOD=34 SCYCLE=3600 CYCLE=60 TI.OUH: .WORD 0 .ASCII /:/ TI.OUM: .BYTE 0,0 .ASCII /:/ TI.OUS: .BYTE 0,0 S.RRES=46 TI.DPT: .WORD 0,0 TI.DPH: .WORD 6,45700 TI.DPM: .WORD 0,3600. TI.DPS: .WORD 0,60. TI.TMP: .WORD 0 TMOV @#V.RRES,-(SP) ;GET BACK PART 2 REGS. JSR R5,@(SP)+ CMP (SP)+,(SP)+ ;REMOVE PART 2 CALL INC AS.ND3+4 ;MUST RECALL KBL THIS TIME MOV @#V.SVT,R1 ;GET PTR TO SVT. MOV R1,R0  ;... & HENCE TO TABLE IF ANY ADD #V.BAT,R0 MOV R0,R5  ;ALSO TO MON/USER SW. ADD #5,R5 TST @SP  ;SET UP OR CLEAR? BEQ AS.CLR  ;GO ELSEWHERE FOR LATTER ;REDUCE NEW ENTRY TO FINAL FORM: MOV SP,R2  ;GET BOTTOM OF ENTRY ADD #12,R2  ; .END I.SR4: .WORD 0 TI.TPS=177564 TI.TPB=177566 .=.+TIME+376-. TI.ND: .=.+TIME-2+KBI.OZ-. .END (UNIT WORD) MOV SP,R3  ;FORGET LOG NAME FOR NOW TST (R3)+ SWAB @R2  ;ADJUSY UNIT WORD ... MOVB #4,@R2  ;... TO SHOW WORD COUNT AS.CDL: TST (R3)+  ;LOOK FOR NON-0 ENTRY BNE AS.CDD DECB @R2  ;ADJUST BYTE COUNT UNTIL FND MOV (SP)+,@SP ;... & MOVE DOWN LOG NAME CMP R3,R2  ;... AS FAR AS UNIT WORD BLO AS.CDL AS.CDD: CMP (R2)+,(R2)+ ;GET PROPER STACK TOP ;CHECK IF TABLE ALREADY - IF NOT START ONE: MOV @R0,R4  ;ANY TABLE YET? BNE AS.TUW TSTB;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ;VERSION NUMBER: V000A @R5  ;PROGRAM UNDERWAY? BNE AS.SUB  ;IF PROGRAM U/W SPEC ACTION REQD MOV @R1,R3  ;NO - GET EOM TO ACCESS ... CMP -(R3),-(R3) ;LINK WORDS ALREADY PROVIDED TSTB -1(R5)  ;IF PROGRAM IN CORE ... BEQ AS.STS CMP R3,V.BFE(R1) ;... & NO ADDITIONS TO RESMON BNE .+4 TST (R3)+  ;... LEAVE ONE AS SW. AS.STS: MOV R3,@R0  ;STORE RESULTANT START ADDR BR AS.SUG  ;CONTINUE LATER ;IF TABLE EXISTS, FIND END: AS.TNX: CMP (R3;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ;VERSION NUMBER: V000A ; TIMER KEYBOARD RESPONSE PROGRAM (PART II) ; EXPECTS THE KEYBOARD COMMAND: ; TIME [HH:MM:SS] ; THE STATED TIME IS ENTERED INTO THE TIME CELLS ; OTHERWISE THOSE CELLS ARE TYPED (IN )+,#-1 ;LOOK FOR SEGMENT END BNE .+6 MOV @R3,R3  ;IF FOUND GET NEXT LINK BR AS.TUW+2  ;START CHECK AFRESH MOVB 2(R3),R4 ;IF NOT THERE GET NEXT ENTRY ASL R4 CMP (R4)+,(R4)+ ADD R3,R4 CMP -(R3),@SP ;SAME DATASET? BNE AS.TUW MOV #-1,(R3)+ ;IF SO REPLACE WITH LINK MOV R4,@R3 AS.TUW: MOV R4,R3  ;RESET PTR .... TST @R3  ;... & LOOK FOR END BNE AS.TNX ;END FOUND - CHECK USER PROGRAM STATE: CMP -(R3),#-1 ;PREVIOUS WORD A LINK? BEQ .+4  .TITLE TMON ;TRANSIENT MONITOR VERSION 1 DEC 70 ; ; OCCUPIES MEMORY WHENEVER THERE IS NO ; CURRENT USER PROGRAM IN OPERATION ; ; LOADED AFTER MONITOR INIT. OR AT ; END OF USER RUN THRU .EXIT CALL. ; ;FUNCTIONS: THE SAME FORMAT) .TITLE KBI.TX R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .BYTE 0,-1 ; GENERATE OUTPUT T.NOAG: MOV @#S.RRES,-(SP) ; RESTORE STACK JSR R5,@(SP)+ CMP (SP)+,(SP)+ MOV R4,TI.SR4 ; SAVE REG 4 MOV @#SVT.,R2 MOV PC,R0 ADD #TI.DPT-.,R0 ; FOR TIME AND CONVERSIONS MOV TOD(R2),(R0)+ ; GET TOD MOV TOD+2(R2),(R0) MOV PC,R4  ; OUTPUT POINTER ADD #TI.OUH-.,R4 TI.OLP: CMP (R0)+,(R0)+ ; A;IF SO REMOVE IT TST (R3)+ TSTB @R5  ;USER UNDERWAY? BEQ AS.SUG AS.SUB: MOV #1,-(SP) ;IF SO MUST GET BUFFER MOV @#V.GTB,-(SP) JSR R5,@(SP)+ MOV (SP)+,R4 ;... IF ANY AVAILABLE BEQ AS.DER  ;IF NOT TREAT AS ERROR TST @R0  ;FIRST ENTRY? BNE .+6 MOV R4,@R0  ;IF SO STORE IN SVT. BR AS.SUG-2 MOV #-1,(R3)+ ;OTHERWISE SET LINK MOV R4,@R3 MOV R4,R3  ;.... & RESET PTR ;SET UP TABLE ENTRY: AS.SUG: MOV (SP)+,(R3)+ ;STORE LOG NAME MOV R2,; 1) CHECKS FOR OUTSTANDING I/O LINKS ; VIA MONITOR DDB CHAIN. IF ANY, PERFORMS ; NECESSARY .CLOSE & .RLSE OPERATIONS ; 2) EFFECTIVELY REDUCES CORE OCCUPANCY ; TO PERMANENT MONITOR & PRE-LOADING ASSIGNMENTS ; ONLY. ; 3) TIDIES MONITOR TABLES FOR THIS STATE & ; IN PARTICULAR, RESTORES MRT. TO GENERATED FORM ; BY READING COPY FROM DISK. ; 4) ON COMPLETION OF CORE RESTORATION, ACTS AS ; KEYBOARD LISTENER FOR MONITOR COMMANDS. FOR GENERAL ; CALLS USES THE INTERPRETER TO EFFECT ACTIODJUST MULT. JSR PC,TI.EXR  ; EXTRACT NUMBER OF HOURS MOVB R3,(R4)+ MOVB R2,(R4)+ INC R4  ; SKIP COLON CMP @R0,#60. ; END ? BNE TI.OLP MOV #TI.TPS,R3 ; PRINTER STATUS MOV @R3,R2  ; TYPE OUT TIME CLR (R3)+ JSR R5,TI.TWT SUB #11,R4  ; OUTPUT POINTER MOV #10,R0 TI.TOL: MOVB (R4)+,@R3 JSR R5,TI.TWT DEC R0 BNE TI.TOL MOV R2,-(R3)  ; RESET TTY STATUS MOV TI.SR4,R4 ; RESTORE R4 MOV #1,R0 CLR R5 INC T.END+4  ; EXIT R4  ;STORE BOTTOM OF NEW ENTRY MOV -(R4),(R3)+ ;... & MOVE IN CMP R4,SP BNE .-4 MOV #177566,R4 ;RESET TO TPB BR AS.CLX  ;JOIN CLEAR ROUTINE FOR EXIT ;COMMAND HAS NO ARGS - CLEAR PRESENT TABLE: AS.CLR: MOV SP,R2  ;SET POINTER BELOW DUMMY TABLE ADD #16,R2 TSTB -1(R5)  ;CHECK IF PROGRAM IN CORE BNE AS.DER  ;REJECT COMMAND IF SO MOV @R0,R3  ;OTHERWISE GET START OF TABLE BEQ AS.RTN  ;... IF ANY!! CLR @R0  N ; REQUIRED. THE FOLLOWING COMMANDS HOWEVER CAN ; ONLY BE CONSIDERED WHEN THERE IS NO USER ; PROGRAM RESIDENT - THESE ARE HANDLED BY TMON ; ITSELF:- ;  LOGIN ;  FINISH ;  RUN ;  GET ;  OTHER ; ; FOLLOWING 'RUN' OR 'GET', OPENS FILE ; SPECIFIED AND PASSES CONTROL TO THE RUN-TIME ; LOADER TO COMPLETE THE READING OF THE PROGRAM ; IT CONTAINS. ; ; ON ENTRY FROM '.EXIT', STACK IS SET AT LOAD POINT ; & R5 IS SET TO THE ADDRESS OF MONITOR DDB CHAIN ; IN SVT. ; ;REGISTERBR T.END ; EXTRACT ROUTINE; GIVEN CONSTANT ADDRESS IN R0 DIVIDES ; BY IT AND RETURNS TWO ASCII INTEGERS IN R2 AND R3 ; (MOST) SIGNIFICANT IN R3 TI.EXR:  CLR R2 TI.SUL: SUB @R0,TI.DPT+2  ; GENERATE NUMBER IN R0 SBC TI.DPT BIC #100000,TI.DPT+2 BCS TI.SOF   ; PARTIAL OVERFLOW SUB -2(R0),TI.DPT BCS TI.DOF INC R2 BR TI.SUL TI.DOF: ADD @R0,TI.DPT+2  ; CORRECT OVERFLOW BVC TI.ADC INC TI.DPT BIC #100000,T;... & REMOVE FROM SVT. ;COMMON EXIT - PROVIDES LAST LINK - ; & ADJUSTS EOM IF NECESSARY: AS.CLX: CLR (R3)+  ;CLEAR TWO LINK WORDS CLR (R3)+ TSTB @R5  ;PROGRAM UNDERWAY? BNE AS.RTN MOV R3,(R1)+ ;IF NOT SET NEW MONTOP TSTB -(R5)  ;IF NOT IN TMON CTRL ... BEQ AS.RTN ADD #40,R3  ;.. SET TOB ALSO MOV @(R1)+,@R3 ;RESET STACK STOP CLR @-(R1)  ;... & REMOVE OLD MOV R3,@R1  ;STORE NEW TOB BR AS.RTN .=.+AS.DO+376-6-. AS.DER: CLR R0  ;IF COMMAND ASSIGNMENTS: R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL TMON ;SHUT DOWN OUTSTANDING I/O: TMON: MOV PC,R3  ;GET ADDR OF LINK BLOCK ADD #TM.LNK-.,R3 TM.GO: MOV @R5,@R3  ;GET DDB ADDR IF ANY BEQ TM.IOC MOV @R5,R0  ;SET POINTER TO IT MOV -(R0),R2 ;GET ASSOC. DVR ADDR CMP (R0)+,(R2)+ TST @R2  ;... & CHK IF FILE DEVICE BPL TM.NFS TST 6(R0)  ;IF SO, IS FILE OPEN? BEQ TM.NFS MOV R3,-(SP) ;YI.DPT+2 TI.ADC: ADD -2(R0),TI.DPT BR TI.DVI TI.SOF: ADD @R0,TI.DPT+2 BVC TI.CRR INC TI.DPT BIC #100000,TI.DPT+2 TI.CRR: CLR R3   ; INTEGERS IN R2 AND R3 TI.DVI: SUB #10.,R2 BCS TI.DDN INC R3 BR TI.DVI TI.DDN: ADD #72,R2   ; CONVERT TO ASCII ADD #60,R3 RTS PC ; TTY WAIT ROUTINE TI.TWT: BIT #200,@#TI.TPS BEQ TI.TWT RTS R5 SVT.=40 TOD=34 SCYCLE=3600 CYCLE=60 TI.OUH: .WORD 0 .ASCII /:/ T REJECT SET ERROR AS.RTN: CLR R5  ;ALSO FOR ALL SET DONE MOV R2,SP  ;CLEAN UP STACK AS.ND3=.   ;.... & DROP THRU TO EXIT V.SVT=40 V.RRES=46 V.GTB=54 V.BAT=12 V.BFE=56 .=.+AS.DO-2+KBI.OZ-. .END ES - MUST CLOSE IT EMT .CLOSE TM.NFS: MOV R3,-(SP) ;... BEFORE TRY RELEASE EMT .RLSE BR TM.GO  ;... & REPEAT IF MORE ;CLEAR FREE CORE: TM.IOC: RESET   ;FOR SAFETY, STOP ALL INTS CMP @#100,#374 ;MUST RESTART CLOCK ... BEQ .+6  ;IF VECTOR NOT SET, NO CLOCK MOV @PC,@#177546 MOV R5,R4  ;SET 2ND PTR TO SVT. ADD #V.BFE-V.DCO,R4 MOV @R4,R2  ;GET 'REAL' RESMON TOP MOV -(R5),R0 ;ANY ASSIGNMENTS? BEQ TM.ATC CI.OUM: .BYTE 0,0 .ASCII /:/ TI.OUS: .BYTE 0,0 S.RRES=46 TI.DPT: .WORD 0,0 TI.DPH: .WORD 6,45700 TI.DPM: .WORD 0,3600. TI.DPS: .WORD 0,60. TI.TMP: .WORD 0 TI.SR4: .WORD 0 TI.TPS=177564 TI.TPB=177566 .=.+T.NOAG+376-. T.END: .=.+T.NOAG-2+KBI.OZ-. .END MP R0,R2  ;IF SO PRE-LOAD? BNE TM.ATC-2 ;NO - MUST SCRUB TM.SAT: TST @R0  ;FIND END OF SECTION BEQ TM.ATE  ;... BY ENTRY SEARCH COM @R0 BEQ TM.ATE COM (R0)+ MOVB 2(R0),R1 ;NOT FND YET - GET NEXT ASL R1 ADD R1,R0 CMP (R0)+,(R0)+ BR TM.SAT  ;... & TRY AGAIN TM.ATE: CMP R0,R2  ;IF END ALSO AT 'REAL' MONTOP ... BEQ .+6  ;.... TABLE GOES!! MOV R0,R2  ;OTHERWISE SET MONTOP AT END BR .+4 CLR @R5  ;FOR POST-LOAD, CLEAR PTR TM.ATC:  CLR (R2)+  ;CLEAR LINK IN ANY CASE CLR (R2)+ MOV R2,-(SP) ;LEAVE ROOM FOR NEW ASSIGNS ADD #1000,R2 ADD #V.EOM-V.BAT,R5 ;SET EOM ABOVE THIS MOV R2,(R5)+ ADD #40,R2  ;RESET TOB ACCORDINGLY CMP R2,@R5  ;(UNLESS ALREADY THERE!) BEQ .+6 MOV @(R5)+,@R2 ;... WITH APPROP STACK STOP CLR @-(R5)  ;... & OLD ONE CLEAR MOV R2,(R5)+ ;CLEAR BUFFER ALLOCATION: MOV @R4,R0  ;SET PTR TO ALLOC. TABLE CMP -(R4),(R5)+ ;... & ADJ PTRS CLR -(R0)  ;ZERO TABLE ENTRY CMP R0,@R4  ;... & REPEAT IF MORE BNE .-4 ;DO OTHER SVT. CLEAN-UP: CLR @R5  ;REMOVE PROG LOAD ADDR ADD #V.MUS-V.PLA,R5 ;JUMP TO M/U SW. CLR (R5)+  ;... & CLEAR IT CMP (R5)+,-(R4) CLR (R5)+  ;REMOVE START/RESTARTS CLR (R5)+ CLR (R5)+ MOV R4,@R5  ;RESET WAIT LOOP PTR ADD #V.WTL-V.SSP,(R5)+ ;ENSURE DDL CLEAN: MOV -(R4),R0 ;GET DDL ADDRESS ADD #6,R0  ;... & ITS END MOV (R0)+,R2 TM.ZDL: TST -(R2)  ;IF ENTRY HAS DISK INFO BEQ .+6 CLR -4(R2)  ;... CANNOT BE RESIDENT CMP -(R2),-(R2) ; GO TO NEXT ENTRY CMP -(R2),@R0 ;... UNLESS ALL DONE BNE TM.ZDL ;RESTORE MRT. FROM DISK COPY: MOV R3,R2  ;SET SYS DSK IN LINK BLK ADD #6,R2 MOV @(R4)+,(R2)+ TST (R2)+  ;NOW SET UP TRAN BLOCK MOV -(R4),R0 ;...COMPUTE MRT SIZE SUB -(R4),R0 ;... AS WORD COUNT ASR R0 MOV @R4,(R2)+ ;SET MRT START ADDR MOV R0,@R2  ;... & COMPUTED COUNT CMP -(R2),-(R2) ;RESET PTR TO TBLK START MOV R3,-(SP) ;.INIT DISK EMT .INIT MOV R2,-(SP) ;.TRAN MRT. COPY MOV R3,-(SP) EMT .TRAN TST 6(R2)  ;IF DISK FAILS ... BPL .+6 CLR -(SP)  ;... IT'S FINAL!!!! IOT CLR -(R4)  ;FINALLY REMOVE PROGNAME CLR -(R4) ADD #V.OSW-V.PGN,R4 ;LEAVE PTR AT OTHER SW. ;INITIALISE LINK-BLOCKS: MOV R3,R0  ;SET PTR TO OUTPUT BLOCK TST -(R0)  ;...SKIPPING ERROR RTN SUB #16,R3  ;AND TO INPUT BLOCK MOV -(R0),@R3 ;INIT. BOTH TO KB CMP -(R3),-(R3) ;SET BOTH PTRS AT LINK CMP -(R0),-(R0) CMP -(R0),-(R3) ;CHECK FOR READ/WRITE IN CORE: MOV 2(R2),R1 ;GET MRT. ADDR CMP (R1)+,(R1)+ ;... & GO TO WRITE EMT MOV @R1,-(SP) ;PERHAPS SAVE CONTENT ASR @SP  ;CHECK IF DISK INFO BCS .+6 CLR @SP  ;IF NOT SET FLAG FOR LOADER BR TM.RWR  ;... & SKIP NEXT SEQUENCE ROL @SP  ;OTHERWISE RESTORE DISK INFO ADD #12,R2  ;...& USE EMBEDDED ONE FOR NOW MOV R2,@R1  ;SET MRT. ACCORDINGLY MOV R2,4(R1) ;NOW CAN WRITE PROG IDENTITY: TM.RWR: MOV R0,-(SP) ;.INIT OUTBLK EMT .INIT MOV PC,-(SP) ;.WRITE HDR,OUTBLOCK ADD #TM.HDR-.,@SP MOV R0,-(SP) EMT .WRITE ;WHILE PRINTING, SET UP INPUT FILE: MOV #60,R1  ;SAVE CURRENT KBD INT VECTOR MOV @R1,-(SP) TST @R4  ;IN 'OTHER' MODE? BNE TM.OTH  ;IF SO SET UP ELSEWHERE MOV PC,@"R1  ;FORCE ALL KBD INTS HERE IF NOT ADD #TM.KIS-.,@R1 TM.SIF: MOV PC,-(SP) ;GET INFILE BLOCK ADD #TM.INF-.,@SP MOV R3,-(SP) ;... & INIT INBLOCK EMT .INIT MOV R3,-(SP) ;GET READY FOR OPEN MOV R0,-(SP) ;BUT FIRST SEE IF HDR DONE EMT .WAIT EMT .OPEN  ;IF SO OPEN INPUT FILE MOV V.EOM-V.OSW(R4),R2 ;RESET EOM.... MOV 4(SP),V.EOM-V.OSW(R4) ;...NOW BUFFERS EST. MOV R2,4(SP)  ;(BUT SAVE FOR LATER) ;GET COMMAND INPUT: TM.RDS: MOV PC,-(SP) ;PRINT READY MA&RK ($) ADD #TM.DOL-.,@SP MOV R0,-(SP) EMT .WRITE MOVB @PC,@#177560 ;REENABLE KBD INTS CLR TM.ISW  ;SET COMMAND START SW. TM.RDC: MOV PC,R5  ;SET POINTER TO BUFFER ADD #TM.IBF-.,R5 MOV R5,-(SP) ;... & SET UP READ MOV R3,-(SP) EMT .READ MOV PC,R2  ;SET POINTER TO CHECK TABLE ADD #TM.CTB-.,R2 CMP (R5)+,(R5)+ ;MOVE TO BUFF BYTE COUNT MOV R3,-(SP) ;WAIT FOR INPUT TO COMPLETE EMT .WAIT MOV (R5)+,R1 ;NOW GO TO END BYTE ADD R5,R1 CMP*B -(R1),#13 ;IF VT, CTL/C INPUT BNE TM.DEC MOV PC,-(SP) ;SO ECHO ACCORDINGLY ADD #TM.CTLC-.,@SP MOV R0,-(SP) EMT .WRITE MOV R0,-(SP) ;... & WAIT TILL DONE EMT .WAIT BR TM.RDC  ;RETURN FOR COMMAND PROPER TM.OTHR: HALT  ;NOT YET IMPLEMENTED!! BR .-2 ;COMMAND RECEIVED - CHECK IF HANDLED BY TMON: TM.DEC: CLRB @#177560 ;STOP INTS WHILE CMD PROCESSED CMPB @R1,#14  ;TERMINATED BY FORM-FEED? BNE .+4 INCB (R1).+  ;IF SO REPLACE WITH RETURN MOV R5,-(SP) ;SAVE BUFF START PTR CMPB (R5)+,#73 ;... & LOOK FOR COMMENT BEQ .+6 CMP R5,R1 BNE .-10 MOVB -(R1),-(R5) ;IF FOUND REPLACE WITH RETURN MOV R5,R1  ;RESET END ACCORDINGLY MOV (SP)+,R5 ;RESET START PTR CMP R1,R5  ;END HERE ALSO? BEQ TM.RDS  ;IF SO NO ACTION - GET NEXT INPUT TSTB (R1)+ CMP @R5,(R2)+ ;GET 1ST 2 CHARS ... BEQ TM.CMD  ;... & CHECK WITH INTERNAL CMDS BHI .-4 2;... CALL NORMAL INTERPRETER: ; EXPECTS R1,R4 & R5 SET AS SHOWN ON KBI LISTING TM.GKI: MOV @SP,R2  ;GET START OF MINIMAL DRIVER MOV -(R2),R2 ;GET PTR TO SAVE AREA COM (R2)+  ;FORCE MSGE PRINT ON RTN TST (R2)+  ;SKIP ITS OUTBUFF PTRS INCB @(R2)+  ;... BUT FORCE PROPER EXIT MOV R4,-(SP) ;SAVE IMPORTANT REGS MOV R3,-(SP) MOV R0,-(SP) MOV R2,-(SP) ;... & END OF SAVE AREA MOV (R2)+,R4 ;PICK UP TPS POINTER CLR R0  ;RAISE PRIORITY TO 4 ...6 MOV @R4,-(SP) ;...& RETURN WITH IT MOV (R4)+,-(R0) ; (USING DONE BIT) JSR PC,TM.KIG ;SIMULATE CALL TO KBL ...    ;... & THENCE TO KBI ;ON RETURN, WAIT END OF TERMINAL MESSAGE: MOV (SP)+,R0 ;GET BACK KBD SAVE PTR MOV R3,-(R0) ;... & INSERT PTRS FROM KBL MOV R2,-(R0) CLRB @#177776 ;SAFE NOW TO DROP PRIORITY MOV (SP)+,R0 ;RESTORE TMON REGS. MOV (SP)+,R3 BITB #100,@R4 ;CHECK PRINTER BUSY ... BNE .-4  ;... & WAIT TILL MSGE DONE MOV (SP)+,R4 ;WH:EN DONE, .... BR TM.RDS  ;...RETURN FOR NEXT INPUT TM.KIG: EMT .KBI  ;RTN ADDR ON STACK = KBL CALL ;KEYBOARD INTERRUPT SERVICE: TM.KIS: MOV @#V.RSAV,-(SP) ;SAVE REGS. JSR R5,@(SP)+ MOV #177562,R3 ;SET PTR TO TKB MOV @R3,R0  ;... & GET INPUT MOVB R0,-(SP) ;STRIP PARITY BIT IF ANY BICB #200,@SP CMPB (SP)+,#3 ;LOOK FOR CTL/C BEQ TM.KIV TST TM.ISW  ;IF NOT THIS TIME, U/W ALREADY? BNE TM.KIU MOV @#V.RRES,-(S>P) ;IF NOT IGNORE THIS INPUT JSR R5,@(SP)+ RTI TM.KIV: ADD #10,R0  ;CVT CTL/C TO VT INC #0  ;ALLOW INPUT NOW TM.ISW=.-2 TM.KIU: MOV @#V.SVT,R4 ;GET KB DVR ADDRESS MOV @V.KBA(R4),R1 CLR -(SP)  ;... & BUILD INTSVCE ENTRY MOVB 5(R1),@SP ADD R1,@SP CLR -(R3)  ;STOP INTS FOR NOW JMP @(SP)+  ;... & GO TO DVR .EOT B;INTERNAL COMMAND - DESPATCH TO SERVICING ROUTINE: ; MUST ASCEND IN ORDER OF 2ND CHAR. VALUE TM.CTB: .WORD "GE .WORD "FI .WORD "LO .WORD "OT .WORD "RU .WORD -1  ;STOP CODE TM.CMD: MOV R5,-(SP) ;SAVE START OF STRING MOVB -(R1),-(SP) ;LEAVE SCRATCH ROOM TM.CML: CMP R5,R1 ;SEARCH FOR END OF CMD NAME BEQ TM.CMG MOVB (R5)+,@SP ;LEAVE PTR ON RETURN ... F CMPB @SP,#40  ;... OR BEYOND SPACE BEQ TM.CMG CMPB @SP,#54  ;... OR COMMA BNE TM.CML TM.CMG: JMP .+2-TM.CTB(R2) ;DESPATCH AS REQD. BR TM.GE BR TM.FI BR TM.LO BR TM.OT BR TM.RU ;LOGIN SERVICE: ; PRESENTLY MERELY ACCEPTS & STORES U.I.C. ;  (PASSWORD & ENTITLEMENT CHECKING MAY BE ADDED) ; COMMAND REJECTED IF ERROR IN FORMAT OR ; USER ALREADY LOGGED IN ;GET CODE ENTERED: TM.LO: MOV R4,R2  ;GET PTR TO UIC IN SVTJ. ADD #V.UIC-V.OSW,R2 TST @R2  ;ALREADY USER ON? BNE TM.LOE+2 MOV R5,@SP  ;IF NOT PUSH PRESENT STRING PTR TM.LOG: CMP @SP,R1  ;IF ALREADY AT END ... BHIS TM.LOE  ;... MUST BE ERROR SWAB @R2  ;ADJUST BYTES (VALID PASS 2) MOV #4,-(SP) ;GET OCTAL TO BIN CVT EMT .CVT MOV (SP)+,R5 ;IF RETURN VALUE = 0 BEQ TM.LOE  ;... IT'S ALSO AN ERROR CMP R5,#377  ;ALSO IF OVER BYTE SIZE! BHIS TM.LOE MOVB R5,@R2  ;STORE VALID BYTE INC @SP  ;ASSUMEN DELIMITED BY COMMA TSTB 1(R2)  ;IF ONLY 1 BYTE DONE, ... BEQ TM.LOG  ;... REPEAT ;INPUT APPARENTLY VALID: ; CHECK IF USER ACCEPTABLE TO BE DONE HERE ;ALL O.K. - EXIT FOR NEXT COMMAND: TM.LOA: CMP (SP)+,(SP)+ ;CLEAN UP STACK JMP TM.RDS  ;GET NEW INPUT ;ERROR IN INPUT: TM.LOE: CLR @R2  ;REMOVE UIC IF INVALID TST (SP)+  ;AGAIN TIDY STACK TM.ERR: MOV (SP)+,R5 ;SET UP DUMMY COMMAND MOV R5,R1  ; (WILL FORCE KBI ... MOV #"RU,(R1)+ ; TO PRINT ERROR MSGE ... R MOV (PC)+,(R1)+ ; REJECTING COMMAND) .BYTE 15,12 BR TM.GKI TM.OT=TM.ERR-2 ;FINISH SERVICE: ; THIS VERSION MERELY CLEARS CURRENT USER - ; REQUIRES EXPANSION TO INCLUDE DISK CLEARANCE TM.FI: MOV 4(SP),@#60 ;RESET KBD INT VECTOR MOV 10(SP),V.EOM-V.OSW(R4) ;SET EOM TO BUFF BOT. CLR V.UIC-V.OSW(R4) ;REMOVE UIC FROM SVT. EMT .XIT  ;USE .XIT TO CLEAN UP ;RUN-GET SERVICE: ; A) CHECKS SPECIFIVED INPUT AVAILABLE:- ; IF NO OWNERSHIP STIPULATED WHEN DEVICE ; IS FILE-TYPE, INPUT WILL BE ASSUMED ; INITIALLY TO BELONG TO LOGGED-IN USER ; OR, BY DEFAULT, TO THE SYSTEM. THERE ; WILL BE NO ASSUMPTION IF OWNER SPECIFIED. ; B) CALLS RUN-TIME LOADER TO ENTER PROGRAM. ; FOLLOWING 'RUN', PROGRAM WILL BE STARTED ; AUTOMATICALLY AT THE APPROPRIATE ADDRESS - ; THAT ESTABLISHED DURING ASSEMBLY OR AT ; LOAD POINT BY DEFAULT. ;GET SPECIFIED INPUT & CHECK AVAILABILITY: TM.GE: CLR R2  ;REZMEMBER IT'S 'GET' TM.RU: MOV V.EOM-V.OSW(R4),@SP ;RESET EOM FOR .... MOV 10(SP),V.EOM-V.OSW(R4) ;PROG D/S SET UP MOV (SP)+,6(SP) ;... & MOVE TO STRING PTR MOV 2(SP),@#60 ;RESET FOR KBI OPERATION ... MOV R2,2(SP) ;... & SAVE REQT FOR START MOV @PC,@#177560 ;ALLOW INTS. AGAINST ERROR MOV #401,V.MUS-V.OSW(R4) ;ALSO ASSUME PROGRAM IN CORE MOV @SP,R2  ;USE CSI TO GET SPECIFICATION JSR PC,TM.CSI ;ALSO CHECK INDIV OWNERSHIP TST R2  ;IF CLEAR, INPUT AVAILABLE BEQ^ TM.RUG TST 6(R1)  ;IF NOT OWNER STIPULATED? BNE TM.RER  ;IF SO, THAT'S IT MOV #401,6(R1) ;OTHERWISE TRY SYSTEM MOV @SP,R2 JSR PC,TM.DCK TST R2  ;IF NOT THERE EITHER ... BNE TM.RER  ;... CAN DO NO MORE CLR -4(R1)  ;IF ERROR NOW, GO E.D.P. ;INPUT PRESENT: - TIDY UP FREE CORE: TM.RUG: MOV R5,@SP  ;RELEASE INPUT CHECK D/S EMT .RLSE MOV R0,-(SP) ;RELEASE KB OUTPUT D/S EMT .RLSE TSTB @R4  ;IF IN 'OTHERb' MODE .. BNE TM.OTR  ;... THERE'S MORE TO DO (????) TM.OTB: MOV R3,-(SP) ;RELEASE CMD D/S EMT .RLSE MOV (SP)+,R3 ;PICK UP GET/RUN SW. ADD #12,R0  ;GET PTR TO SYS D/S MOV R0,-(SP) ;RELEASE THAT TOO EMT .RLSE MOV R0,R2 MOV (R5)+,(R2)+ ;MOVE INPUT DATA TO SYS D/S MOV (R5)+,(R2)+ MOV (R5)+,(R2)+ MOV (R5)+,(R2)+ ;RESET TRUE EOM: MOV (SP)+,R5 ;SAVE RWN DISK INFO ADD #V.EOM-V.OSW,R4 ;GET EOM STORE MOV (SP)+,@R4 ;... & TRUE SETTING MOV R1f,-(SP) ;SAVE FILE BLOCK PTR MOV (R4)+,R1 ADD #40,R1  ;THIS TIME TOB ALSO CMP R1,@R4  ;IF ALREADY SET .... BEQ .+6  ;(THO' CAN'T REALLY BE!) MOV @(R4)+,@R1 ;... LEAVE STACK STOP CLR @-(R4)  ;OTHERWISE RESET & CLR OLD MOV R1,@R4 ;ENSURE RWN IN CORE FOR LOADER: TST R5  ;CHECK FOR DISK INFO FOR RWN BEQ TM.RUO  ;IF NONE RWN ALWAYS RESIDENT ADD #12,R2  ;OTHERWISE WILL USE EMBEDDED VN MOV V.MRT-V.TOB(R4),R1 ;SET MRT. PTR APPROP. CMP (R1)+,(R1)+ jMOV #40,-(SP) ;GET BUFFER MOV @#V.GTB,-(SP) JSR R5,@(SP)+ MOV @SP,@R1  ;STORE ITS START IN MRT MOV @SP,4(R1) ;... BOTH WRITE & READ MOV (SP)+,R1 ;HOLD PTR ... TM.RUL: MOV (R2)+,(R1)+ ;... FOR MOVE DOWN CMP R1,@R4  ;STOP AT STACK STOP BLO TM.RUL ;NOW CALL LOADER: TM.RUO: MOV R0,-(SP) ;RE-INIT SYS DATASET ... EMT .INIT  ;... WITH INPUT SPEC. MOV R0,-(SP) ;... & OPEN IT (FBLK SET) EMT .OPEN MOV R3,-(SP) n;SET RUN-GET SW AS REQD. INC TM.IBF+2 ;SET LINE FOR BIN. READ JMP TM.LDR  ;LEAVE REST TO LOADER ;RUN-GET ERRORS: TM.CSE: TST (SP)+  ;TIDY STACK AS NECESSARY CMP (SP)+,(SP)+ ;... FOR VARYING EXITS TST (SP)+ BR TM.RER  ;OMIT NEXT IF NO .INIT MOV R5,-(SP) ;RELEASE INPUT CHK D/S EMT .RLSE TM.RER: MOV V.EOM-V.OSW(R4),-(SP) ;RESTORE TRUE EOM MOV 10(SP),V.EOM-V.OSW(R4) MOV (SP)+,6(SP) CLRB @#177560 ;AGAIN STOP KBD INTS MOV @#60,2(SP) ;BRING CTRL BACK rTO TMON MOV PC,-(SP) ADD #TM.KIS-.,@SP MOV (SP)+,@#60 CLR V.MUS-V.OSW(R4) ;... WITH NO PROG IN CORE JMP TM.ERR TM.OTR: JMP TM.OTH  ;'OTHER' NOT YET AVAILABLE ;GENERAL ROUTINE TO PROCESS FILE SPECIFIER: ; A) GET SPECIFIER VIA CSI: TM.CSI: MOV R2,-(SP) ;SAVE PTR TO STRING START CMPB @R5,#40  ;CHANGE SPACE ... BNE .+6 MOVB #54,@R5  ;... TO COMMA MOVB (R5)+,(R2)+ ;... & REMOVE COMMAND CMP R5,R1 BLOS TM.CSI+2v MOVB #12,@R2  ;SET LF AS FINAL STOP SUB #24,@SP  ;RESET STRT PTR TO CMDBF MOV @SP,R2  ;... & SAVE IT EMT .CSX  ;GET SYNTAX CHECK TST (SP)+  ;IF ERRORS .... BNE TM.CSE+4 ;... REJECT COMMAND MOV PC,-(SP) ;SET UP CSI CTRL BLK ADD #TM.INF-.,@SP ;... ON STACK MOV PC,-(SP) ADD #TM.RBK-.,@SP MOV R2,-(SP) MOV SP,R2  ;STORE BLOCK PTR MOV R2,-(SP) EMT .CSM  ;GET SPEC DECODED DEC (SP)+  ;RTN CODE =1 ONLY BNE TM.CSE  ;REJECT IF OTHEzRWISE ; B) CHECK INPUT DEVICE VALID: TST (SP)+  ;IGNORE CMDBUF PTR MOV @SP,R5  ;GET LINK PTR MOV V.DDL-V.OSW(R4),R2 ;GET PTR TO DDL MOV R2,R1  ;... & SAVE IT CMP (R1)+,(R1)+ ;MOVE TO DDL END CMP (R1)+,(R5)+ ;... & TO DEVNAM IN LINK CMP (R5)+,(R5)+ MOV @R1,R1  ;START FROM DDL END TM.CSC: SUB #10,R1  ;... & CHK IF DEVICE EXISTS CMP R1,R2 BLO TM.CSE+2 ;AGAIN REJECT IF NOT CMP @R5,@R1 BNE TM.CSC ; C) ~ CHECK IF FILE EXISTS: MOV @SP,R5  ;SAVE LINK BLOCK ADDR EMT .INIT  ;INIT D/S FOR FILE CHK MOV (SP)+,R1 ;GET FILE BLOCK PTR TM.DCK: JSR PC,TM.DCS ;DO LOOK-UP FOR FILE RTS PC  ;THIS IS ERROR EXIT TM.DCS: MOV (SP)+,-4(R1) ; (R2 NON-0) MOV R1,-(SP) ;SET ERROR RTN ... MOV R5,-(SP) ;... & DO LOOK-UP EMT .LUKUP TST (SP)+  ;ON RETURN, IGNORE LENGTH BITB #202,(SP)+ ;IF FILE THERE ... BEQ TM.DCK+4 ;... OR CAN INPUT CLR R2  ;EXIT WITH R2 CLEAR BR TM.DCK+4 .EOT ; TRANSITIONAL MONITOR LOADER PREPROCESSOR ; THIS ROUTINE ASSUMES THAT THE LOAD FILE HAS BEEN ; INITED AND OPENED. IT THEN READS THE COMD, SETS ; UP THE SVT, AND PREPARES THE STACK FOR A LDR CALL. ; THIS MODULE IS CALLED BY ; MOV STARTIND,-(SP) ; JMP TM.LDR ; WHERE STARTIND IS EQUAL TO ; 0 FOR GET ; NON-ZERO FOR RUN ; THE T.M. LINK BLOCK, AS FOUND IN R0 IS USED FOR I/O TRANSFERS ; THE CONTENTS OF R5 ARE CURRENTLY IGNORED R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; LOADER READ ROUTINE - CALL BY JSR R5,LDR.RD LDR.RD: MOV PC,-(SP) ADD #LDR.LN-.,@SP ; READ COMD MOV TM.LBA,-(SP) EMT 4 MOV TM.LBA,-(SP) ; AWAIT COMPLETION EMT 1 MOV PC,R1 ADD #LDR.LN+2-.,R1 ; STATUS WORD BIT (R1)+,#37400 ; ERROR ? BEQ LDR.OK  ; ERROR FREE MOV #1421,-(SP) ; ERROR ON READ IOT LDR.OK: MOV (R1)+,R2 ; BYTE COUNT TST (R1)+  ; IGNORE LOAD ADDRESS ASR R2  ; BLOCK WORD COUNT DEC R2  ; OF DATA ONLY RTS R5 ; RETURNS R1=FIRST DATA WORD, R2=WORD COUNT ; ; BLOCK CHECK ROUTINE LDR.BC: DEC R2 BNE LDR.RI  ; CHECK END JSR R5,LDR.RD ; NEXT BLOCK LDR.RI: RTS R5 TM.LDR: MOV R0,TM.LBA ; SET LNKBLK ADDRESS CLR LDR.GS LDR.RL: JSR R5,LDR.RD ; READ FIRST BLOCK LDR.SX: CLR R3  ; SYNTAX BISB (R1)+,R3 ; COMD CODE BEQ LDR.EC  ; END COMD DEC R3  ; 1 BEQ LDR.GI  ; GENERAL INFO DEC R3  ; 2 BEQ LDR.MR  ; MONITOR ROUTINE LDR.ER: MOV #1422,-(SP) ; ERROR IOT LDR.EC: MOV @TM.LBA,-(SP) ; DDB ADDRESS MOV LDR.GS,-(SP) ; LOAD ADDRESS OF 0 EMT 61 LDR.GI: CLR R0  ; COMD WORD COUNT BISB (R1)+,R0 SUB #5,R0  ; ONLY FIVE WORDS LOOKED AT JSR R5,LDR.BC MOV (R1)+,R3 MOV R3,LDR.GS ; SET LOAD ADDRESS MOV @#LDR.VT,R4 MOV R3,6(R4) ; AND R4 JSR R5,LDR.BC ADD (R1)+,R3 ; LOAD+SIZE CMP R3,4(R4) BLOS LDR.FT  ; IT FITS MOV R3,-(SP) MOV #1423,-(SP) ; PROGRAM TOO LARGE IOT LDR.FT: JSR R5,LDR.BC MOV (R1)+,22(R4) ;START ADDRESS TST @SP  ; RUN ? BEQ LDR.DD  ; GET MOV -2(R1),@SP ; SET START ADDRESS LDR.DD: JSR R5,LDR.BC MOV (R1)+,24(R4) ; DDT START JSR R5,LDR.BC TST (R1)+  ; RELOCATABLE FLAG BEQ LDR.AB CLR -(SP) MOV #1422,-(SP) ; WILL NOT RELOCATE IOT LDR.AB: JSR R5,LDR.BC ; SKIP REMAINING COMD TST (R1)+ DEC R0 BNE LDR.AB JSR R5,LDR.BC BR LDR.SX LDR.MR: CLR R0 BISB (R1)+,R0 ; MONITOR RTN COUNT MOV R0,R3 BEQ LDR.NM  ; NO REQUESTS LDR.ML: JSR R5,LDR.BC MOV (R1)+,-(SP) ; PLACE ROUTINE # ON STACK DEC R0 BNE LDR.ML LDR.NM: JSR R5,LDR.BC MOV R3,-(SP) ; COUNT ON STACK BR LDR.SX LDR.VT=40 .EOT ;DATA BLOCKS: ; (A HEADER MESSAGE: TM.HDR: .WORD 20. .WORD 0 .WORD 20. .BYTE 15,12 .ASCII 'MONITOR V000A' .BYTE 15,12,12 ; B) SIGNAL READY FOR COMMAND: TM.DOL: .WORD 2 .WORD 0 .WORD 2 .BYTE '$,13 ; C) CTL/C ECHO MESSAGE: TM.CTLC: .WORD 6 .WORD 0 .WORD 6 .ASCII '^C' .BYTE 15,12,'.,13 ; D) INPUT FILE BLOCK: .WORD 0  ;NO ERROR RTN - SYS ERROR .WORD 4 TM.INF: 0,0,0,0,0  ;NAME SET VIA CSI ; E) INPUT COMMAND BUFFER .WORD 2,0,0,0,0,0,0 ;REQD FOR CSI LDR.GS=.-4 TM.LBA=.-2 LDR.LN: TM.IBF: .WORD 128. .WORD 0 .WORD 0 .=.+128. ; F) LINK-BLOCK FOR FILE LOOK-UP: .WORD 0  ;NO ERROR POSSIBLE??? TM.RBK: .WORD 0 .WORD -1  ;CANNOT BE ASSIGNED!!! .WORD 1 .RAD50 'DF'  ;DEFAULT IS DSK ; G) LINK-BLOCK FOR INPUT COMMAND: .WORD 0  ;AGAIN SHOULD BE NO ERROR! .WORD 0 .RAD50 'CMD'  ;COMMAND DEVICE .WORD 1 .RAD50 'KB'  ;... NORMALLY KBD ; H) LINK-BLOCK FOR PRINTER MESSAGES: .WORD 0 .WORD 0 .WORD -1  ;AGAIN AVOID ASSIGNMENT .WORD 1 .RAD50 'KB'  ;ALWAYS CONSOLE ; I) LINK BLOCK FOR I/O TIDY & DISK READ: .WORD 0  ;NO ERROR RETURN FOR NOW TM.LNK: .WORD 0  ;PTR TO DDB - SET AS NEC .WORD -1  ;CANNOT BE ASSIGNED!!! .WORD 1 .WORD 0  ;SET TO SYS DSK NAME ; J) TRANSFER BLOCK FOR DISK READ: .WORD 5  ;STD BLOCK FOR MRT COPY .WORD 0,0  ;ADDR & CNT SET BY PROG .WORD 4  ;READ ONLY REQD .WORD 0 ;EMBEDDED READ/WRITE PROCESSOR MUST COME HERE: ;MISC DEFINITIONS: V.EOM=0 V.TOB=2 V.PLA=6 V.BAT=12 V.DCO=14 V.MUS=16 V.OSW=20 V.UIC=40 V.PGN=42 V.MRT=46 V.DDL=50 V.SSP=52 V.BFE=56 V.WTL=60 V.KBA=62 V.SVT=40 V.RSAV=44 V.RRES=46 V.GTB=54 .WAIT=1 .WRITE=2 .READ=4 .INIT=6 .RLSE=7 .TRAN=10 .LUKUP=14 .OPEN=16 .CLOSE=17 .KBI=33 .CVT=42 .CSX=56 .CSM=57 .XIT=60 .END TMON