.TITLE COMACD .ENABL LC ; ; CALL FLTACD( I ) -- This subroutine takes the floating point ; word that is equivalenced in the first two locations of I ; and breaks it into an 8 bit exponent and a 15 bit mantissa. ; These are replaced into the first two locations of I. ; NOTE: Exponent is with a #200 bias. ; .PSECT FLTACD F0=%0 ; FLTACD::STF F0,-(SP) ;SAVE F0 STFPS -(SP) ;SAVE FPPS SETF ;SET FLOATING SETI ;SET INTEGER ; MOV 2(R5),R1 ;GET ADDRESS OF I LDF (R1),F0 ;LOAD NUMBER STEXP F0,R2 ;STORE AWAY EXPONENT. MOV #200,R4 ;ZERO ACTUAL EXPONENT ; 1$: STCFI F0,R3 ;STORE MANTISSA CMP #40000,R3 ;15 BIT MANTISSA? BLE 2$ ;BRANCH IF TRUE INC R2 ;INCREMENT EXPONENT DEC R4 ;DECREMENT ACTUAL EXPONENT LDEXP R2,F0 ;RELOAD EXPONENT BR 1$ ;TRY AGAIN ; 2$: MOV R4,(R1)+ ;STORE EXPONENT MOV R3,(R1) ;STORE MANTISSA ; LDFPS (SP)+ ;RESTORE FPPS LDF (SP)+,F0 ;RESTORE F0 RTS PC ;RETURN ; .PSECT COMDES ; ; ; CALL COMDES( I, N1, W1, A1, N2, W2, A2, OUTDES ) -- This subroutine ; formats a line of output to write the COMPASS routine. Where ; ; I If I=1, label DSCRB is added to output. ; N1, N2 Number of vectors. ; W1, W2 Width of character. ; A1, A2 Address of definition. ; OUTDES Output block containing encoded data. ; .PSECT COMDES ; COMDES::MOV #BLANK,ARGBLK ;SET BLANKS CMP #1,@2(R5) ;I=1? BNE 1$ ;BRANCH IF NOT MOV #LABEL,ARGBLK ;SET LABEL DSCRB ; 1$: MOV @4(R5),N1 ;GET N1 MOV @6(R5),W1 ;GET W1 MOV @10(R5),A1 ;GET A1 MOV @12(R5),N2 ;GET N2 MOV @14(R5),W2 ;GET W2 MOV @16(R5),A2 ;GET A2 ; MOV 20(R5),R0 ;SET OUTPUT BLOCK MOV #FRMT,R1 ;SET FORMAT BLOCK MOV #ARGBLK,R2 ;SET ARGUMENT BLOCK JSR PC,$EDMSG ;MAKE STRING RTS PC ;RETURN ; BLANK: .ASCIZ / / LABEL: .ASCIZ /DSCRB/ .EVEN ARGBLK: .WORD 0 ;ADDRESS FOR BLANK OR LABEL A2: .WORD W2: .WORD N2: .WORD A1: .WORD W1: .WORD N1: .WORD FRMT: .ASCIZ -%5A%5SVFD%4S14/%U,8/%U,8/%U,14/%U,8/%U,8/%U- .EVEN .PSECT COMDEF ; ; CALL COMDEF( I, IVEC, OUTDEF ) -- This subroutine encodes the ; definition block for use with the COMPASS routines. ; ; I If I=0, label DFN is added. ; IVEC Four vectors. ; OUTDEF Output block for encoded data. ; ; COMDEF::MOV #BLK,ARG ;SET BLANKS TST @2(R5) ;ZERO BNE 1$ ;BRANCH IF NOT MOV #LBL,ARG ;SET LABEL ; 1$: MOV 4(R5),R2 ;SET ARGUMENTS MOV #IVEC,R1 ;SET LOCATIONS .REPT 4 MOV (R2)+,-(R1) ;MOVE INTO STORAGE LOCATIONS .ENDR MOV #ARG,R2 ;SET ARGUMENT BLOCK MOV 6(R5),R0 ;SET OUTPUT BLOCK MOV #FRM,R1 ;SET FORMAT BLOCK JSR PC,$EDMSG ;MAKE STRING RTS PC ;RETURN ; BLK: .ASCIZ / / LBL: .ASCIZ /DFN/ .EVEN ARG: .WORD 0 .BLKW 4 IVEC: FRM: .ASCIZ -%3A%7SVFD%4S15/%U,15/%U,15/%U,15/%U- .EVEN .END