.TITLE FORMAT .SBTTL FORMAT .IDENT /V02.00/ .CSECT FORMAT .NLIST CND,TTM ; ; ; COPYRIGHT 1977, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; ; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE ; ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION ; OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT ; AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC. ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ; EQUIPMENT CORPORATION. ; ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY ; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ;VERSION V02.00 ; ;RICK SHAW ; ; MODIFIED BY: ;CHUCK GULDENSCHUH 10-JAN-77 ; ; ; ; ; ; ; .MCALL SUPER SUPER ;I HAD TO ADD THIS TO GET IT TO ASSEMBLE-- MIKE HIGGINS ;---------------------------------------------------------------; ; ; ; FORMAT TYPES: ; ; [ - ; ; ] - CLOSE ESCAPE (OPTIONAL) ; ; ; ; / - ; ; P -
; ; ; ; D - DECIMAL NUMBER ; ; O - OCTAL NUMBER ; ; U - UNSIGNED DECIMAL NUMBER ; ; ; ; S - STRING ; ; N - REPEAT CHARACTER ; ; * - RUN-TIME TYPE ; ; ; ; THE CALL TO $FORMAT IS THRU THE FORMAT MACRO IN ; ; SUPER-MAC: ; ; FORMAT BUFADDR,,PARAMETERS ; ; ; ; WHERE: ; ; BUFADDR = OUPUT BUFFER ADDRESS ; ; PIC = FORMAT STRING ; ; PARAMETERS = PARAMETERS TO BE FORMATTED ; ; (UP TO 8.) ; ; ; ; EXAMPLE: ; ; FORMAT #BUFFER,,VALUE ; ; WOULD GENERATE THE FOLLOWING ASCIZ STRING ; ; STORED STARTING AT LOCATION BUFFER (ASSUMING ; ; VALUE = 37.) ; ; VALUE = 37 ; ; ; ; THE ASTERIK WHEN USED AS A FORMAT TYPE WILL CAUSE ; ; THE NEXT PARAMETER TO BE USED AS THE FORMAT TYPE ; ; TO PROCESSED NEXT. THE NEXT PARAMETER SHOULD BE ; ; AN ASCII CHARACTER. ; ; ; ; THE N TYPE IS USE TO REPEAT ONE CHARACTER SEVERAL ; ; TIMES. THE FIELD SIZE SHOULD BE SEPARATED FROM THE ; ; CHARACTER BY A COLON. ; ; ; ; THE D, O, AND U TYPES MAY ALSO HAVE A FIELD SIZE ; ; ATTACHED. THIS WILL CAUSE THE CORRESPONDING PARA- ; ; METER TO BE LEFT JUSTIFIED IN A FIELD OF THE SPEC- ; ; IFIED NUMBER OF BLANKS. THE FORMAT IS: ; ; [Dn] OR [On] OR [Un] ; ; WHERE n IS A NON-NEGATIVE NUMBER ; ; [D0] IS EQUIVALENT TO [D] ; ; ; ; AN ASTERIK MAY REPLACE THE FIELD SIZE IN ANY CASE. ; ; THIS WILL CAUSE THE NEXT PARAMETER TO BE USED AS ; ; THE FIELD SIZE. ; ; ; ; THE FORMAT MACRO SETS UP FOR THE CALL TO $FORMAT ; ; AS FOLLOWS: ; ; ; ; R1 = -> FORMAT STRING ; ; R2 = -> OUTPUT STRING ; ; ; ; @SP= RETURN ADDRESS ; ; 2(SP) = ARGUMENT #1 ; ; ... ; ; ... ; ; N*2(SP) = ARGUMENT N ; ; ; ; R0 = WORK ; ; R3 = WORK ; ; R0 AND R3 ARE PRESERVED. R2 EXITS POINTING AT ; ; THE NEXT USABLE LOCATION IN THE BUFFER. ; ; ; ;---------------------------------------------------------------; .SBTTL DRIVER PROCEDURE $FORMAT POP RETN AGAIN: LET R0 :B= (R1)+ IFB R0 = #'] THEN GOTO AGAIN IFB R0 = #'[ THEN LET R0 :B= (R1)+ SNEAKY: IFB R0 = #'* THEN POP R0 GOTO SNEAKY END IFB R0 = #'/ THEN GOTO CRLF IFB R0 = #'P THEN GOTO PAGE IFB R0 = #'D THEN GOTO DECM IFB R0 = #'O THEN GOTO OCT IFB R0 = #'U THEN GOTO UNS IFB R0 = #'S THEN GOTO STRING IFB R0 = #'N THEN GOTO REPETE END IF LET (R2)+ :B= R0 IF RESULT IS NE THEN GOTO AGAIN LET R2 := R2 -1 JUMPTO @RETN .SBTTL CURSOR CONTROLS CRLF: LET (R2)+ :B= #15 LET (R2)+ :B= #12 GOTO AGAIN PAGE: LET (R2)+ :B= #14 GOTO AGAIN .SBTTL DECIMAL NUMBER OUTPUT DECM: IFB (R1) = #'* ;RUN TIME FIELD SIZE? TSTB (R1)+ ;YES...CLEAR THE * POP R3 ;GET VALUE FOR THE FIELD ELSE ;NOT A * CALL GETNUM ;FIELD IS IN PIC PART END IF R3 IS NE THEN GOTO DRJUST ;LEFT JUSTIFY IF @SP IS NE THEN GOTO DE1 DE0: LET (R2)+ :B= #60 GOTO DE3 DE1: IF RESULT IS PL THEN GOTO DE2 LET (R2)+ :B= #'- NEG @SP DE2: LET R0 := #TENTAB REPEAT UNTIL -(R0) LOS @SP REPEAT LET @R2 :B= #57 REPEAT LET @R2 :B= @R2 +1 LET @SP := @SP - @R0 UNTIL RESULT IS LO LET @SP := @SP + @R0 LET R2 := R2 +1 UNTIL -(R0) IS EQ DE3: TST (SP)+ LINK0: GOTO AGAIN .SBTTL OCTAL NUMBER OUTPUT OCT: IFB (R1) = #'* TSTB (R1)+ POP R3 ELSE CALL GETNUM END IF R3 IS NE THEN GOTO ORJUST POP R0 LET @R2 :B= #30 SEC REPEAT LET R0 := R0 L.ROTATE 1 ROLB (R2)+ LET @R2 :B= #206 REPEAT LET R0 := R0 L.SHIFT 1 IF RESULT IS EQ THEN GOTO AGAIN ROLB @R2 UNTIL RESULT IS CC END .SBTTL UNSIGNED DECIMAL NUMBER OUTPUT UNS: IFB (R1) = #'* TSTB (R1)+ POP R3 ELSE CALL GETNUM END IF R3 IS NE THEN GOTO URJUST IF @SP IS NE THEN GOTO DE2 GOTO DE0 .SBTTL OUTPUT ASCII STRING STRING: LET R0 := R1 POP R1 WHILE @SP IS NE LET (R2)+ :B= (R1)+ LET @SP := @SP -1 END TST (SP)+ LET R1 := R0 LINK1: GOTO LINK0 .SBTTL OUTPUT A CHARACTER REPEAT COUNT TIMES REPETE: CALL GETVAL IFB (R1) = #': TSTB (R1)+ LET R0 :B= (R1)+ ELSE POP R0 END IF R3 IS GT REPEAT THRU R3 LET (R2)+ :B= R0 END END GOTO LINK1 .SBTTL RIGHT JUSTIFIED OUTPUT DRJUST: IF @SP IS MI NEG @SP LET (R2)+ :B= #'- LET R3 := R3 -1 END URJUST: LET RAD := #12 GOTO JUST1 ORJUST: LET RAD := #10 JUST1: GOTO JUST GETVAL: IFB (R1) = #'* TSTB (R1)+ POP R0,R3 PUSH R0 RETURN END .SBTTL GETNUM GETNUM: LET R3 :B= (R1) LET R3 := R3 - #'0 IF RESULT IS EQ ORB R3 GT #9. LET R3 := 0 RETURN ELSE TSTB (R1)+ END REPEAT LET R0 :B= (R1)+ IFB R0 LT #'0 ORB R0 GT #'9 TSTB -(R1) RETURN END PUSH R3 LET R0 := R0 - #'0 LET R3 := R3 L.SHIFT 2 LET R3 := R3 + (SP)+ LET R3 := R3 L.SHIFT 1 LET R3 := R3 + R0 END .SBTTL RIGHT JUSTIFY A NUMBER JUST: IF R3 IS GT REPEAT THRU R3 LET (R2)+ :B= #40 END END LET R3 := R2 POP R0 PUSH R1,R2 LET R2 := RAD WHILE R0 IS NE CALL DDIV LET R1 := R1 + #60 LET -(R3) :B= R1 END POP R2,R1 GOTO LINK1 .SBTTL ***** DDIV- -DIVISION ROUTINE ;THIS PROCEDURE DIVIDES R0 BY R2 LEAVING THE QUOTIENT IN R0, ;THE REMAINDER IN R1, AND R2 UNCHANGED. PROCEDURE DDIV PUSH #16. ;SHIFT COUNT LET R1 := 0 ;CLEAR OUT REMAINDER DIV1: LET R0 := R0 L.SHIFT 1 ;DOUBLE PRECISION SHIFT ROL R1 IF R2 HI R1 THEN GOTO DIV22 ;WILL DIVISOR GO IN? LET R1 := R1 - R2 ;YES. SUBTRACT THE DIVISOR LET R0 := R0 +1 DIV22: DEC (SP) ;DONE? BGT DIV1 ;BRANCH IF NO TST (SP)+ ;CLEAN OFF THE STACK ENDPROCEDURE DDIV RAD: .WORD 0 RETN: .WORD 0,1,10.,100.,1000.,10000. TENTAB: .END