.TITLE GDDMED - DATA MEDIA COLOR SCAN WITH RETRO/GRAPHICS DRIVER .IDENT /VERS30/ .SBTTL HOW TO CUSTOMIZE THIS PACKAGE .ENABLE LC ; This file contains the Data Media/Retro-Graphics driver ; for DIGLIB for RT-11, TSX-Plus, and RSX11M. ; This file is conditionally assembled to meet your specific ; hardware and software needs. Left alone, this file will produce ; a Data Media driver for RSX11M with F4P/F77 with the command ; character of the 4027 emulation mode of the Retro-Graphics set to ; the exclamation point. In order to change this, you can either edit ; this file directly or assemble it with a symbol definition file first. ;1) SET THE SYMBOL "OS" TO: ; 1 ==> RT11 ; 2 ==> TSX ; 3 ==> RSX11M (IMPLIES F4P/F77) .IF NDF OS OS = 3 .ENDC ;2) SET "CC" TO THE DATA MEDIA 4027 EMULATION COMMAND CHARACTER .IF NDF CC CC = '! ;EXCLAMATION POINT .ENDC ;3) SET THE SYMBOL "HAVEIS" TO 1 IF YOUR MACHINE HAS THE EIS OPTION ; OTHERWISE, LEAVE HAVEIS UNDEFINED (COMMENTED OUT). ; HAVEIS = 1 .SBTTL DEFINATIONS, ECT. ;;;;;;;;;; TSX AND RSX11M MACHINES HAVE EIS .IF NDF HAVEIS .IF NE OS-1 HAVEIS = 1 .ENDC ;NE OS-1 .ENDC ;NDF HAVEIS .IF EQ OS-3 .MCALL QIOW$, DIR$ .IFF .MCALL .PRINT, .TTYIN JSW = 44 TTSPC = 50000 ;SPECIAL MODE + LOWER CASE ENABLE .ENDC ;OS-3 .GLOBL GDAID, GDGAID F0 = %0 ;FLOATING PT. REG. 0 FOR RSX11M .IF EQ OS-3 BUFSIZ = 130. .IFF BUFSIZ = 78. .ENDC ;OS-3 GS = 29. ;DEFINE TEKTRONIX 4010 CONTROL CODES US = 37 ;GO TO ASCII MODE CR = 15 LF = 12 ESC = 33 TMODE = 30 ;GO TO TRANSPARENT MODE ;ERROR MACRO DEFINATION .MACRO ERROR TEXT JSR R0,ERROR1 .ASCIZ @TEXT@ .EVEN .ENDM ERROR .PSECT GDDMED ;WE ARE RELOCATABLE .SBTTL ENTRY POINT GDDMED:: TST (R5)+ ;SKIP ARG COUNT MOV @(R5)+,R0 ;GET FUNCTION TO PERFORM BLE 1$ ;ITS A BADDY ASL R0 ;MAKE WORD OFFSET ADD #DSPTBL-2,R0 ;R0 ==> ADDRESS OF PROCESSING ROUTINE CMP R0,#TBLEND ;SEE IF UNSUPPORTED FUNCTION BGE 1$ ;YES JMP @(R0)+ ;NO, DISPATCH TO ROUTINE 1$: ERROR DSPTBL: .WORD INIT, BGNPLT, MOVE, DRAW, ENDPLT, RLSDEV .WORD GETCHR,SETCOL,GIN .WORD SETRGB, SETHLS TBLEND: .SBTTL INIT AND BGNPLT ; ;INITIALIZE - FUNCTION 1 ; INIT: .IF EQ OS-2 ;IF BLOODY TSX, THEN MOV #ON,R0 ;TELL TSX TO LEAVE OUR TTY OUTPUT ALONE EMT 375 .IFTF MOV 2(R5),R4 ;R4 ==> YA(1) CLR (R4)+ ;YA(1) = 0.0 CLR (R4)+ ; MEANS NO ERRORS ON INIT. JSR PC,DOINIT ;INIT. BUFFER JSR R4,INSEND .ASCII '"6g' ;SWITCH DATA MEDIA FROM TRANSPARENT TO 4027 .ASCII 'WOR 30''GRA 1,30';PREPARE FOR GRAPHICS .ASCII 'COL C0''LIN 1' ;FOREGROUND COLOR, SOLID LINES .ASCIZ 'SHR N' ;NO SHRINKING OF COORDINATES .EVEN RTS PC .IFT ON: .BYTE 1,120 ;FROM BILL MCDONALD .ENDC ;EQ OS-2 ; ;BGNPLT - FUNCTION 2 ; BGNPLT: JSR PC,DOINIT ;KILL ANY LEFT OVER GRAPHICS JSR R4,INSEND ;SEND BGNPLT MESSAGE .ASCII 'ERA G' ;ERASE GRAPHICS .ASCIZ 'COL C0' ;SELECT FOREGROUND COLOR .EVEN CLR XPOSN ;AND RESET X & Y POSN CLR YPOSN RTS PC ;DONE .SBTTL MOVE AND DRAW ; ;MOVE - FUNCTON 3 ; MOVE: JSR PC,MAKINT ;SCALE SCREEN CM COORD. TO GDU MOV NEWX,XPOSN ;SET NEW POSITION MOV NEWY,YPOSN SETPOS: MOVB #1,DOINGV ;SHOW MOVED RTS PC ;RETURN TO FORTRAN ; ;DRAW - FUNCTION 4 ; DRAW: JSR PC,MAKINT ;CONVERT SCREEN CM COORD. TO GDU CMPB DOINGV,#2 ;SEE IF IN A SERIES OF VECTORS BEQ ADDTO ;YES, JUST ADD THIS ONE STVCT: JSR PC,SETXY ;START A VECTOR AT XPOSN,YPOSN MOVB #2,DOINGV ;SHOW VECTOR MODE ADDTO: CMP BUFCNT,#BUFSIZ-8. ;SEE IF ROOM FOR MORE BPL STVCT ;NOPE, RESTART MOV NEWY,R3 ;AND DO NEW POINT JSR PC,CVTY MOV NEWX,R3 ;AND X PART JSR PC,CVTX ALLDON: MOV NEWX,XPOSN ;AND SET TO NEW POSITION MOV NEWY,YPOSN RTS PC SETXY: CMP BUFCNT,#BUFSIZ-15. ;SEE IF ENOUGH ROOM LEFT IN BUFFER BLO 1$ ;YES JSR PC,PLTMT1 ;EMPTY BUFFER 1$: JSR R4,INSERT ;AND START A VECTOR .BYTE GS,0 .EVEN INCB USEDGS ;SHOW WE HAVE A GS IN THE BUFFER MOV YPOSN,R3 ;DO OLD Y JSR PC,CVTY MOV XPOSN,R3 ;DO OLD X ALSO JSR PC,CVTX RTS PC ;ALL DONE NOW .SBTTL ENDPLT AND RLSDEV ; ;END OF PLOTTING (FLUSH BUFFER) - FUNCTION 5 ; ENDPLT: JSR PC,PLTMTY ;FORCE LAST BUFFER OUT RTS PC ; ;RELEASE DEVICE - FUNCTION 6 RLSDEV: JSR R4,INSEND .ASCIZ '"0g' ;RETURN TO TRANSPARENT MODE .EVEN .IF EQ OS-2 ;IF BLOODY TSX, THEN MOV #OFF,R0 ;TELL TSX "NORMAL" TTY I/O EMT 375 .IFTF RTS PC .IFT OFF: .BYTE 0,120 .ENDC ;EQ OS-2 .SBTTL GETCHR - GET CHARACTERISTICS ; ;GET DEVICE CHARACTERISTICS - FUNCTION 7 ; GETCHR: MOV (R5)+,R4 ;R4 ==> OUTPUT ARRAY MOV #CHRTBL,R0 ;R0 ==> OUR CHARACTERISTICS MOV #CWORDS,R1 ;R1 = NUMBER OF WORDS TO MOVE 1$: MOV (R0)+,(R4)+ ;MOVE CHARACTERISTICS SOB R1,1$ RTS PC CHRTBL: .FLT2 800.0, 24.7062, 16.2 XGUPCM: .FLT2 25.864 YGUPCM: .FLT2 25.864 .FLT2 7.0 .FLT2 229.0 ;RASTER, ERASE WRITE, GIN AVAILABLE ;COLORS RGB AND HLS SETABLE .FLT2 1.0 ;NEED EVERY LINE FILLED CWORDS = <.-CHRTBL>/2 .SBTTL SELECT COLOR ; ;SELECT COLOR - FUNCTION 8 ; SETCOL: JSR PC,PLTMTY JSR PC,GETINT ;GET COLOR NUMBER CMP R1,#7 ;SEE IF LEGAL COLOR NUMBER BHI COLERR ;YES MOVB CMAP(R1),R0 ;MAP FOREGROUND COLOR NUMBER TO 4027 ;COLOR NUMBER JSR R4,INSERT ;INSERT CHANGE COLOR COMMAND .ASCIZ 'COL C' .EVEN MOVB R0,@BINPTR ;INSERT COLOR NUMBER INC BINPTR ;BUMP POINTER INC BUFCNT ;COUNT THIS CHARACTER JSR PC,PLTMT2 RTS PC CMAP: .BYTE '7,'0,'1,'2,'3,'4,'5,'6 .EVEN COLERR: ERROR .SBTTL GIN COMMAND COMMON ; ;GRAPHICS INPUT WITH PICK CHARACTER - FUNCTION 8 ; GIN: JSR PC,PLTMTY ;FLUSH BUFFER ; JSR R4,INSERT ;DO A POSITION COMMAND ; .BYTE GS,0 ; .EVEN ; INCB USEDGS ;SHOW A GS IN LINE ; MOV GINY,R3 ;MOVE TO PREVIOUS GIN POSITION ; JSR PC,CVTY ;CONVERT TO 4010 CODE ; MOV GINX,R3 ;X LAST FOR 4010 ; JSR PC,CVTX ; JSR PC,PLTMT2 ;EMPTY THE CURRENT BUFFER JSR PC,GETLIN ;GET THE RESPONSE MOV (R5)+,R4 ;R4 ==> ARRAY FOR CHAR,X,Y JSR PC,GINCHR ;GET GIN CHARACTER STRUCK .IF EQ OS-3 ;IF RSX11M, THEN F4P/F77, SO FPU SETF SETI LDCIF R0,F0 ;FLOAT R0 INTO F0 STF F0,(R4)+ ;PLACE CHARACTER FIRST IN ARRAY .IFF ;NO FPU JSR PC,FLOAT ;FLOAT THE NUMBER MOV R0,(R4)+ ;PLACE IT FIRST IN THE ARRAY MOV R1,(R4)+ .ENDC ;EQ OS-3 MOV R4,UNXADD ;SHOW WHERE TO STORE X IN CM. ADD #4,R4 ;FIGURE OUT WHERE Y IN CM. GOES MOV R4,UNYADD ;SHOW WHERE TO STORE Y IN CM. JSR PC,UNPACK ;GET IX MOV R0,GINX ;SAVE GIN X POSITION JSR PC,UNPACK ;GET IY MOV R0,GINY ;SAVE IY MOV #UNSCR5,R5 ;PREPARE TO UNSCALE IX,IY TO X,Y JSR PC,GDGAID ;CALL FTN TO UNSCALE RTS PC ;AND DONE UNSCR5: .WORD 6 .WORD GINX,GINY,XGUPCM,YGUPCM UNXADD: .WORD 0 UNYADD: .WORD 0 .SBTTL DATA MEDIA "GETLIN" GETLIN: .IF EQ OS-3 ;RSX-11M MOV #FLUSH,QDPB+Q.IOPL ;SET ADDRESS OF FLUSH TYPE AHEAD MOV #FLSIZ,QDPB+Q.IOPL+2 ;NUMBER OF BYTES MOV #SF.SMC,QDPB+Q.IOFN ;SET FUNCTION TO SET MULT. CHAR DIR$ #QDPB ;FLUSH THE TYPEAHEAD BUFFER MOV #BUFST,QDPB+Q.IOPL ;SET BUFFER START ADD. MOV #25.,QDPB+Q.IOPL+2 ;SET EXPECTED NUMBER OF BYTES .IF EQ CC-176 MOV #IO.RPR!TF.RNE!TF.RAL,QDPB+Q.IOFN ;SET FUNCTION TO ;READ AFTER PROMPT WITH NO ECHO ;AND READ ALL BITS .IFF MOV #IO.RPR!TF.RNE,QDPB+Q.IOFN ;SET FUNCTION TO READ ;AFTER PROMPT WITH NO ECHO .ENDC MOV #PROMPT,QDPB+Q.IOPL+6 ;SET PROMPT ADDRESS MOV #PRSIZE,QDPB+Q.IOPL+10 ;SET PROMPT SIZE MOV #40,QDPB+Q.IOPL+12 ;VFC IS NORMAL DIR$ #QDPB ;EXECUTE THE READ BCS RDERR ;ERROR ON DIRECTIVE REJECTED CMPB IOSB,#IS.SUC ;MAKE SURE IT WORKED BNE RDERR MOV #BUFST,R0 ;R0 ==> INPUT DATA MOV #24.,R1 ;PREPARE TO FIX UP THE CHARACTERS 1$: BICB #200,(R0)+ ;CLEAR MSB DEC R1 ;DO ALL OF THEM BNE 1$ CLRB (R0)+ ;AND TERMINATE STRING .IFF ;OS-3 ;RT-11 OR TSX .PRINT #PROMPT ;ASK FOR A CURSOR READING MOV #BUFST,R1 ;PREPARE TO READ DATA INTO BUFFER BIS #TTSPC,@#JSW ;INHIBIT ECHO AND ENABLE LOWER CASE 1$: .TTYIN ;GET A CHAR INTO R0 CMPB R0,#12 ;SEE IF A LINEFEED BEQ 2$ ;IF SO, NEARLY ALL DONE MOVB R0,(R1)+ ;INSERT CHARACTER INTO BUFFER BR 1$ ;GO GET ANOTHER CHARACTER 2$: CLRB (R1)+ ;TERMINATE STRING BIC #TTSPC,@#JSW ;RESTORE ECHO AND ONLY UPPER CASE .IFTF ;OS-3 ;COMMON TO ALL OS'S JSR PC,SCOMP ;SEE IF WE GOT WHAT WE THINK WE SHOULD BEQ 4$ ;YES JSR R4,INSEND ;SEND ERROR MESSAGE .ASCIZ "ERROR READING CURSOR - TRY AGAIN"<15><12> .EVEN BR GETLIN 4$: RTS PC ;ALL DONE .IFT ;OS-3 ;RSX11M FLUSH: .BYTE TC.TBF .BYTE 0 FLSIZ = . - FLUSH RDERR: ERROR .ENDC ;OS-3 PROMPT: .ASCII <15>"ENA 1" PRSIZE = . - PROMPT .IIF NE OS-3 .BYTE 0 .EVEN SCOMP: MOV #BUFST,R3 ;GET POINTER INTO INPUT BUFFER MOV #DATSTR,R0 ;GET POINTER TO STRING TO COMPARE WITH 2$: TSTB (R0) ;SEE IF END OF DATA STRING BEQ 3$ ;IF SO, WE HAVE A MATCH CMPB (R0)+,(R3)+ ;SEE IF STRING COMPARE IN THIS CHAR. BEQ 2$ ;IF SO, GO BACK AND TRY NEXT CHAR. 3$: RTS PC ;RETURN WITH ZERO FLAG SET PROPERLY ;ZERO=TRUE FOR MATCH ;ZERO=FALSE FOR NO MATCH DATSTR: .ASCIZ "DAT 03," .EVEN GINCHR: JSR PC,UNPACK ;GET GIN CHARACTER BIC #177600,R0 ;MAKE 7 BIT ASCII RTS PC UNPACK: MOV #3,R0 ;PREPARE FOR 3 DIGITS CLR R1 ;ZERO OUR NUMBER BR 2$ ;GO INTO LOOP 1$: .IF DF HAVEIS MUL #10.,R1 ;ADJUST FOR ENTRY OF NEXT DIGIT .IFF ASL R1 ;MULT. BY 2 MOV R1,-(SP) ;SAVE X2 ASL R1 ;X4 ASL R1 ;X8 ADD (SP)+,R1 ;X8+X2 = X10 .ENDC ;DF HAVEIS 2$: MOVB (R3)+,R2 ;GET ASCII CHAR SUB #60,R2 ;MAKE NUMBER ADD R2,R1 ;ADD IT IN SOB R0,1$ ;DO ALL CHARS. INC R3 ;SKIP OVER COMMA MOV R1,R0 ;PLACE IN R0 RTS PC .SBTTL DEFINE COLOR IN RGB AND HLS ; ;DEFINE COLOR USING RGB - FUNCTION 10 ; SETRGB: JSR PC,PLTMTY ;FLUSH BUFFER OF ANYTHING JSR R4,INSERT ;START THE COMMAND .ASCIZ 'MIX C' .EVEN DEFCOM: JSR PC,GETINT ;GET THE COLOR NUMBER INTO R1 CMP R1,#7 ;SEE IF IN RANGE BLOS 1$ ;YES, GO ON JMP COLERR ;NOPE, GIVE ERROR 1$: MOVB CMAP(R1),@BINPTR ;PUT COLOR NUMBER (ASCII) INTO BUFFER INC BUFCNT ;COUNT THIS CHARACTER INC BINPTR ;MOVE TO NEXT FREE JSR R4,INSERT ;INSERT A SPACE .ASCIZ ' ' .EVEN JSR PC,GETINT ;GET Y(1) = %RED OR HUE JSR PC,BINASC ;MAKE ASCII AND INSERT JSR R4,INSERT ;SEPERATE WITH COMMA .ASCIZ ',' .EVEN JSR PC,GETIN2 ;GET Y(2) = %GREEN OR LIGHTNESS JSR PC,BINASC ;MAKE ASCII AND INSERT JSR R4,INSERT ;SEPERATE WITH COMMA .ASCIZ ',' .EVEN JSR PC,GETIN2 ;GET Y(3) = %BLUE OR SATURATION JSR PC,BINASC ;MAKE ASCII AND INSERT JSR PC,PLTMT2 ;SEND IT NOW RTS PC ; ; DEFINE COLOR USING HLS - FUNCTION 11 ; SETHLS: JSR PC,PLTMTY ;FLUSH BUFFER JSR R4,INSERT ;SET FOR HLS COLOR SELECTION .ASCIZ 'MAP C' .EVEN BR DEFCOM ;DO COMMON STUFF BINASC: CLR R2 ;ZERO CHARACTER COUNT OF ASCII STRING TST R1 ;SEE IF MINUS BPL 1$ ;NOPE MOVB #'-,-(SP) ;SHOW MINUS INC R2 ;COUNT THIS CHARACTER NEG R1 ;MAKE PLUS 1$: CLR R0 ;ZERO HIGH PART FOR DIVIDE DIV #10.,R0 ;GET NEXT DIGIT AS REMAINDER ADD #'0,R1 ;MAKE ASCII MOVB R1,-(SP) ;SAVE DIGIT INC R2 ;COUNT THIS DIGIT MOV R0,R1 ;GET QUOTIENT READY FOR NEXT DIVIDE BNE 1$ ;DO AGAIN IF MORE TO DO ADD R2,BUFCNT ;COUNT CHARACTERS WE WILL ADD TO BUFFER MOV BINPTR,R3 ;R3 ==> OUTPUT BUFFER 2$: MOVB (SP)+,(R3)+ ;INSERT STRING SOB R2,2$ ;DO ALL CHARACTERS MOV R3,BINPTR ;SAVE UPDATED POINTER RTS PC .SBTTL ASCII CODING ROUTINES CVTX AND CVTY CVTY: MOV #96.,LOBIAS ;Y LOW BIAS IS 96 BR CVT ;GO CONVERT CVTX: MOV #64.,LOBIAS ;X LOW BIAS IS 64 CVT: MOV BINPTR,R1 ;GET A POINTER INTO BUFFER MOV R3,-(SP) ;SAVE A COPY BIC #176037,R3 ;GET HIGH 5 BITS ASL R3 ;POSITION THEM ASL R3 ASL R3 SWAB R3 ;FINALLY GOT EM INTO LOW 5 BITS ADD #32.,R3 ;CODE AS CHARACTER MOVB R3,(R1)+ ;INSERT INTO BUFFER MOV (SP)+,R3 ;GET COPY BACK BIC #177740,R3 ;ONLY LOW BITS ADD LOBIAS,R3 ;MAKE PROPER CHARACTER MOVB R3,(R1)+ ;INSERT IT ALSO MOV R1,BINPTR ;RESTORE POINTER ADD #2,BUFCNT ;ACCOUNT FOR INSERTING TWO RTS PC ;WE DID IT ALL LOBIAS: .WORD 0 .SBTTL MAKINT SUBROUTINE MAKINT: MOV (R5)+,XADD ;PASS X ARG ON MOV (R5)+,YADD ;PASS Y ARG ON MOV #SCLR5,R5 ;PREPARE TO CALL A FTN CALC. ROUTINE JSR PC,GDAID RTS PC SCLR5: .WORD 6 XADD: .WORD 0 YADD: .WORD 0 .WORD XGUPCM .WORD YGUPCM IXADD: .WORD NEWX IYADD: .WORD NEWY GETINT: MOV (R5)+,R4 ;POINT TO FLOATING VALUE GETIN2: .IF EQ OS-3 ;IF RSX11M, THEN F4P/F77, SO FPU SETF SETI LDF (R4)+,F0 ;GET FLOATING VALUE STCFI F0,R1 ;PLACE 16 LSB IN R1 RTS PC ;THATS IT .IFF ;NO FPU MOV (R4)+,R0 ;GET HIGH PART MOV (R4)+,R1 ;GET LOW PART MOV R0,R3 ;COPY EXPONENT MOV R0,-(SP) ;SAVE SIGN ALSO BIC #177600,R0 ;GET MANTISSA (ALMOST) BIS #200,R0 ;RESTORE HIDDEN BIT TO MANTISSA ASL R3 ;ALIGN EXPON. IN HIGH BYTE SWAB R3 ;PUT IN LOW BYTE BIC #177400,R3 ;GET ONLY EXPON. SUB #200,R3 ;TAKE OUT EXCESS 200 FROM EXPON. BLE 2$ ;IF <0 THEN NUMBER <1 SUB #24.,R3 ;COMPUTE RIGHT SHIFT COUNT CMP R3,#8. ;SEE IF > 2**32 -1 BGE 2$ ;IF THAT BIG, USE ZERO ASHC R3,R0 ;SHIFT RIGHT PROPER NUMBER OF BITS TST (SP)+ ;SEE IF MINUS BPL 1$ COM R0 ;NEG. D.P. INTEGER NEG R1 ADC R0 ;PROPAGE CARRY 1$: RTS PC ;AND DONE 2$: CLR R1 ;RETURN 0 CLR R0 TST (SP)+ ;FORGET STUFF ON STACK RTS PC FLOAT: MOV R0,R1 ;PREPARE TO FLOAT BEQ 9$ ;ALL DONE SIZE ITS ZERO CLR R0 ;ZERO HIGH PART MOV R2,-(SP) ;SAVE R2 MOV #46000,R2 ;R2=EXPONENT OF 24 BIT NUMBER 1$: SUB #200,R2 ;WHACK DOWN EXPONENT AS WE NORMALIZE ASL R1 ;SHIFT LOW LEFT ROLB R0 ;SHIFT HIGH LEFT BPL 1$ ;NOPE, KEEP ON SHIFTING BIC #177600,R0 ;KILL MSB BIS R2,R0 ;MAKE FLOATING PT. EXP + MANTISSA MOV (SP)+,R2 ;RESTORE R2 9$: RTS PC ;DONE .ENDC ;EQ OS-3 .SBTTL UTILITY ROUTINES ; ;CALL PLTMTY ; ;THIS ROUTINE EMPTIES THE GRAPHICS BUFFER PLTMTY: CMPB DOINGV,#1 ;SEE IF BEAM WAS POSITIONED? BNE PLTMT1 ;NOPE JSR PC,SETXY ;YES, MOVE THERE PLTMT1: TST BUFCNT ;MAKE SURE SOMETHING TO SEND BEQ EXIT PLTMT2: MOV BINPTR,R1 ;SET INPUT POINTER IN R1 TSTB USEDGS ;SEE IF A "GS" IN CURRENT LINE BEQ 1$ ;NOPE MOVB #US,(R1)+ ;INSERT A GO TO ASCII MODE INC BUFCNT ;INCLUDE THIS CHAR 1$: .IF NE OS-3 ;RT-11 AND TSX CLRB (R1)+ ;ZERO BYTE TERMINATES WITH CR/LF .PRINT #BUFST ;DO THE I/O NOW .IFF ;RSX11M JSR PC,DOQIO ;SEND TO THE TERMINAL .ENDC ;OS-3 DOINIT: CLRB DOINGV ;NOT DOING A VECTOR CLRB USEDGS ;NO GS IN NEXT LINE YET. CLR BUFCNT ;NO CHARS LEFT IN BUFFER ANY MORE MOV #BUFST,BINPTR ;RESTORE TO START OF BUFFER EXIT: RTS PC ;AND DONE .IF NE OS-3 ;RT11 AND TSX ERROR1: MOV R0,-(SP) ;SAVE POINTER TO ERROR CODE .PRINT #NAME ;OUTPUT DRIVER NAME MOV (SP)+,R0 ;RESTORE POINTER TO TEXT .PRINT ;MAKE .PRINT CALL TRAP 300+63. ;GIVE FORTRAN ERROR MESSAGE .IFF ;RSX11M ERROR1: MOV #BUFST,R1 ;R1 ==> ERROR MESSAGE AREA MOV #NAME,R2 ;R2 ==> START OF MESSAGE 1$: MOVB (R2)+,(R1)+ ;MOVE START OF MESSAGE BNE 1$ ;GO TILL ALL MOVED DEC R1 ;BACK UP TO NEXT FREE BYTE 2$: MOVB (R0)+,(R1)+ ;PLACE SECOND HAVE OF MESSAGE IN BUFFER BNE 2$ CLR -(SP) ;2ND WORK OF MESSAGE BLOCK MOV #BUFST,-(SP) ;SET ADDRESS OF TEXT MOV SP,R0 ;R0 ==> MSG BLOCK CLR R1 ;SIGNAL NOT AN ERROR YET JSR PC,$ERRLG ;TYPE OUR MESSAGE CMP (SP)+,(SP)+ ;CLEAN UP THE STACK TRAP +341 ;GIVE NON-FTN4PLUS ERROR MESSAGE .ENDC ;F4P NAME: .IIF NE OS-3 .BYTE 15,12 .ASCIZ 'GDDMED - ' .EVEN INSERT: CLR INFLG ;SHOW INSERT BR PUT INSEND: MOV R4,INFLG ;SHOW INSEND PUT: MOV R1,-(SP) ;SAVE R1 MOV BINPTR,R1 ;GET POINTER TO BUFFER 1$: MOVB (R4)+,(R1)+ ;INSERT A CHAR BEQ 2$ ;BRANCH ON END OF STRING INC BUFCNT ;ADD UP CHARS CMP BUFCNT,#BUFSIZ-1 ;CHECK FOR TOO MANY BMI 1$ ;NOPE ERROR 2$: DEC R1 ;BACK UP TO REAL CHAR MOV R1,BINPTR ;RESTORE POINTER MOV (SP)+,R1 ;RESTORE R1 TST INFLG ;SEE IF WE SHOULD SEND ALSO BEQ EVNOUT ;NOPE JSR PC,PLTMT2 ;SEND BUFFER EVNOUT: INC R4 ;MAKE R4 EVEN BIC #1,R4 RTS R4 .IF EQ OS-3 .SBTTL QIO DRIVER DOQIO: MOV #BUFST,QDPB+Q.IOPL ;SET BUFFER ADDRESS MOV BUFCNT,QDPB+Q.IOPL+2 ;SET BYTE COUNT MOV #'+,QDPB+Q.IOPL+4 ;SET TO FORT. VFC - SUPPRESS LF MOV #IO.WAL,QDPB+Q.IOFN ;SET TO WRITE VIRTUAL BLOCK MOV #5,QDPB+Q.IOLU ;SET LUN=5 (TI:) DIR$ #QDPB ;EXECUTE THE QIO BCS WRTERR ;OOPS TSTB IOSB ;MAKE SURE TRANSFER WORKED BMI WRTERR ;OOPS RTS PC ;WHEW, WE DID IT UNDER RSX WRTERR: ERROR QDPB: QIOW$ IO.WAL,0,24.,0,IOSB,0, IOSB: .BLKW 2 .ENDC ;OS-3 .SBTTL VARIABLES AND BUFFER XPOSN: .WORD 0 YPOSN: .WORD 0 NEWX: .WORD 0 NEWY: .WORD 0 GINX: .WORD 640./2 ;X CENTER GINY: .WORD 420./2 ;Y CENTER INFLG: .WORD 0 DOINGV: .BYTE 0 USEDGS: .BYTE 0 .EVEN BINPTR: .WORD 0 BUFCNT: .WORD 0 BUFST: .BLKB BUFSIZ .END