; VOUT - Virtual Screen Support for VTAM ; ; Copyright [c] Noel Alaska Systems Technology, 1985. SEARCH SYS ; AMOSL librarys SEARCH SYSSYM SEARCH TRM SEARCH VTAMEQ ; VTAM library TRUE = 0 ; conditional assembly stuff FALSE = ^C TRUE DEBUG = FALSE INTERN VOUT,VTCRT,VUNLD,PRTPIC,ALLCON,RELCON AUTOEXTERN VOUT: SAVE A0-A5,D0-D5 ; save regs AND #177,D1 ; turn off hi order bit CMPB D1,#177 ; is this a rub? JEQ XT129 ; YES - handle ala TCRT 129 CMPB D1,#37 ; is this a ctl char? BHI XOUT2 ; NO - put on v screen CMPB D1,#10 ; is ctl a backspace? JEQ XT5 ; YES - handle ala TCRT 5 CMPB D1,#12 ; is ctl a linefeed? JEQ XT4 ; YES - handle ala TCRT 4 CMPB D1,#15 ; is ctl a carriage return? JEQ XT2 ; YES - handle ala TCRT 2 CMPB D1,#11 ; is this a TAB? JNE XEXIT ; NO MOV COL(A5),D0 ; YES - pick up column # DEC D0 ; less 1 'cause home is 1,1 MOV D0,D1 ; save position in D1 OR #7,D0 ; move out to mod 8 position INC D0 SUB D1,D0 ; compute # spaces to output 1$: MOVB #40,D1 ; write them to v con CALL VOUT ; ***** RECURSIVE CALL ***** SOB D0,1$ REST A0-A5,D0-D5 RTN ; NO - ignore other ctls XOUT2: CMM CMAX(A4),COL(A5) ; will this char overflow line? BGE 0$ ; NO MOV D1,D2 ; YES - CRLF first MOVW #255.*256.+2,D1 CALL VTCRT MOVW #255.*256.+4,D1 CALL VTCRT MOV D2,D1 0$: MOV ROW(A5),D2 ; pick up line address DEC D2 ; (less one 'cause home is 1,1) BITL #L25OK,JSTAT(A4) ; ok to honor line 25 calls? BEQ 1$ ; NO BITL #L25,VTCURA(A5) ; is line 25 call active? BEQ 1$ ; NO MOV RMAX(A4),D2 ; YES - adjust row # 1$: MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD COL(A5),D2 ; add column number DEC D2 ; (less one 'cause home is 1,1) ADD D2,D2 ; two bytes per char MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOVB D1,@A2 ; store character CLRB 1(A2) ; clear character attribs BITL #CURALI,VTCURA(A5) ; supposed to be low intensity? BEQ 2$ ; NO BISB #CURALI,1(A2) ; YES - set it 2$: BITL #CURAGR,VTCURA(A5) ; supposed to be graphic? BEQ 3$ ; NO BISB #CURAGR,1(A2) ; YES - set it 3$: BITL #CURAG2,VTCURA(A5) ; supposed to be spc graphic? BEQ 4$ ; NO BISB #CURAG2,1(A2) ; YES - set it AND #~CURAG2,VTCURA(A5) ; clear special graphic bit 4$: INC COL(A5) ; increment position XEXIT: REST A0-A5,D0-D5 RTN PAGE VTCRT: SAVE A0-A5,D0-D5 ; save registers TSTW D1 ; see if direct addressing BMI XCRT2 ; NO PUSH D1 ; YES - set cursor AND #377,D1 MOV D1,COL(A5) POP D1 RORW D1,#8. AND #377,D1 MOV D1,ROW(A5) TST COL(A5) ; audit cursor info BNE 1$ ; (COL must be GT zero) INC COL(A5) ; (but can be GT CMAX) 1$: TST ROW(A5) ; (ROW must be GT zero) BNE 2$ INC ROW(A5) 2$: CMM ROW(A5),RMAX(A4) ; (ROW must be LE RMAX) BLE 3$ MOV RMAX(A4),ROW(A5) 3$: REST A0-A5,D0-D5 RTN XCRT2: ANDW #377,D1 ; clear hi-order byte CMPW D1,#192. ; is TCRT to big? BLO 1$ ; NO JMP XTNULL ; YES - ignore it 1$: ADDW D1,D1 ; double call # MOVW D1,D0 ; save index value MOVW XCRT3[~D1],D1 ; get offset value ADDW D0,D1 ; setup for jmp JMP XCRT3[~D1] XCRT3: OFFSET XT0 ; 0 - clear screen OFFSET XT1 ; 1 - home OFFSET XT2 ; 2 - return OFFSET XT3 ; 3 - cursor up OFFSET XT4 ; 4 - cursor down OFFSET XT5 ; 5 - cursor left OFFSET XT6 ; 6 - cursor right OFFSET XTNULL ; 7 - keyboard lock OFFSET XTNULL ; 8 - keyboard unlock OFFSET XT9 ; 9 - erase to EOL OFFSET XT10 ; 10- erase to EOS OFFSET XT11 ; 11- low intensity OFFSET XT12 ; 12- high intensity OFFSET XT13 ; 13- enable protected fields OFFSET XT14 ; 14- disable protected fields OFFSET XT15 ; 15- delete line OFFSET XT16 ; 16- insert line OFFSET XTNULL ; 17- delete char OFFSET XTNULL ; 18- insert char OFFSET XTNULL ; 19- read cursor address OFFSET XTNULL ; 20- read char @ cursor OFFSET XT21 ; 21- start blinking field OFFSET XT22 ; 22- end blinking field OFFSET XT23 ; 23- start line drawing mode OFFSET XT24 ; 24- end line drawing mode OFFSET XTNULL ; 25- set horizontal position OFFSET XTNULL ; 26- set vertical position OFFSET XTNULL ; 27- set terminal attributes OFFSET XT28 ; 28- cursor on OFFSET XT29 ; 29- cursor off OFFSET XT30 ; 30- start underscore OFFSET XT31 ; 31- end underscrore OFFSET XT32 ; 32- start reverse video OFFSET XT33 ; 33- end reverse video OFFSET XT34 ; 34- start reverse blink OFFSET XT35 ; 35- end reverse blink OFFSET XTNULL ; 36- turn off screen display OFFSET XTNULL ; 37- turn on screen display OFFSET XT38 ; 38- top left corner OFFSET XT39 ; 39- top right corner OFFSET XT40 ; 40- bottom left corner OFFSET XT41 ; 41- bottom right corner OFFSET XT42 ; 42- top intersect OFFSET XT43 ; 43- right intersect OFFSET XT44 ; 44- left intersect OFFSET XT45 ; 45- bottom intersect OFFSET XT46 ; 46- horizontal line OFFSET XT47 ; 47- vertical line OFFSET XT48 ; 48- intersection OFFSET XT49 ; 49- solid block OFFSET XT50 ; 50- slant block OFFSET XT51 ; 51- cross-hatch block OFFSET XT52 ; 52- double line horizontal OFFSET XT53 ; 53- double line vertical OFFSET XTNULL ; 54- send msg to function key line OFFSET XTNULL ; 55- send msg to shift function key line OFFSET XTNULL ; 56- set normal display format OFFSET XTNULL ; 57- set horizontal split (follow w/row #) OFFSET XTNULL ; 58- set vertical split (39 char col) OFFSET XTNULL ; 59- set vertical split (40 char col) OFFSET XTNULL ; 60- set vertical split to next char OFFSET XTNULL ; 61- activate split segment 0 OFFSET XTNULL ; 62- activate split segment 1 OFFSET XT63 ; 63- send message to host msg field OFFSET XT64 ; 64- up arrow OFFSET XT65 ; 65- down arrow OFFSET XT66 ; 66- raised dot OFFSET XT67 ; 67- end of line marker OFFSET XT68 ; 68- horizontal tab symbol OFFSET XT69 ; 69- paragraph OFFSET XT70 ; 70- daggar OFFSET XT71 ; 71- section OFFSET XT72 ; 72- cent sign OFFSET XT73 ; 73- one-quarter OFFSET XT74 ; 74- one-half OFFSET XT75 ; 75- degree OFFSET XT76 ; 76- trademark OFFSET XT77 ; 77- copyright OFFSET XT78 ; 78- registered OFFSET XT79 ; 79- print screen OFFSET XTNULL ; 80- undefined OFFSET XTNULL ; 81- undefined OFFSET XTNULL ; 82- undefined OFFSET XTNULL ; 83- undefined OFFSET XTNULL ; 84- undefined OFFSET XTNULL ; 85- undefined OFFSET XTNULL ; 86- undefined OFFSET XTNULL ; 87- undefined OFFSET XTNULL ; 88- undefined OFFSET XTNULL ; 89- undefined OFFSET XTNULL ; 90- undefined OFFSET XTNULL ; 91- undefined OFFSET XTNULL ; 92- undefined OFFSET XTNULL ; 93- undefined OFFSET XTNULL ; 94- undefined OFFSET XTNULL ; 95- undefined OFFSET XTNULL ; 96- undefined OFFSET XTNULL ; 97- undefined OFFSET XTNULL ; 98- undefined OFFSET XTNULL ; 99- undefined OFFSET XTNULL ;100- undefined OFFSET XTNULL ;101- undefined OFFSET XTNULL ;102- undefined OFFSET XTNULL ;103- undefined OFFSET XTNULL ;104- undefined OFFSET XTNULL ;105- undefined OFFSET XTNULL ;106- undefined OFFSET XTNULL ;107- undefined OFFSET XTNULL ;108- undefined OFFSET XTNULL ;109- undefined ; ----- begin DRAVAC defined functions -------------------- OFFSET XT110 ;110- DRAVAC - ul curve graphic OFFSET XT111 ;111- DRAVAC - ur curve graphic OFFSET XT112 ;112- DRAVAC - ll curve graphic OFFSET XT113 ;113- DRAVAC - lr curve graphic OFFSET XTNULL ;114- undefined OFFSET XT115 ;115- DRAVAC - fwd slash graphic OFFSET XT116 ;116- DRAVAC - bwd slash graphic OFFSET XT129 ;117- DRAVAC - end line 25 OFFSET XTNULL ;118- DRAVAC - turn line 25 on OFFSET XTNULL ;119- DRAVAC - turn line 25 off OFFSET XTNULL ;120- DRAVAC - line lock line OFFSET XTNULL ;121- DRAVAC - remove line lock OFFSET XTNULL ;122- undefined OFFSET XTNULL ;123- undefined OFFSET XTNULL ;124- undefined OFFSET XTNULL ;125- undefined OFFSET XTNULL ;126- undefined OFFSET XTNULL ;127- undefined ; ----- begin SuperVue defined functions -------------------- OFFSET XT128 ;128- start line 25 (line 0 on some terms) OFFSET XT129 ;129- end line 25 " OFFSET XTNULL ;130- line lock on OFFSET XTNULL ;131- line lock off OFFSET XT132 ;132- clear line 25 OFFSET XTNULL ;133- start underline (per char type) OFFSET XTNULL ;134- end underline " ; ----- begin Alpha-Base defined functions ------------------ OFFSET XT135 ;135- screen bright OFFSET XT136 ;136- screen dark OFFSET XT137 ;137- key click on OFFSET XT138 ;138- key click off OFFSET XT139 ;139- blank on OFFSET XT140 ;140- blank off OFFSET XT141 ;141- reverse/blink/underline on OFFSET XT142 ;142- reverse/blink/underline off OFFSET XT143 ;143- reverse/underline on OFFSET XT144 ;144- reverse/underline off OFFSET XT145 ;145- blink/underline on OFFSET XT146 ;146- blink/underline off OFFSET XT147 ;147- cursor blink block OFFSET XT148 ;148- cursor steady block OFFSET XT149 ;149- cursor blink underline OFFSET XT150 ;150- cursor steady underline OFFSET XT151 ;151- send msg to host msg field (centered) OFFSET XT129 ;152- end msg to host msg field OFFSET XTNULL ;153- turn on line 25 user msg OFFSET XTNULL ;154- undefined OFFSET XTNULL ;155- undefined OFFSET XTNULL ;156- undefined OFFSET XTNULL ;157- undefined OFFSET XTNULL ;158- undefined OFFSET XTNULL ;159- undefined OFFSET XTNULL ;160- undefined OFFSET XTNULL ;161- undefined OFFSET XTNULL ;162- undefined OFFSET XTNULL ;163- undefined OFFSET XTNULL ;164- undefined OFFSET XTNULL ;165- undefined OFFSET XTNULL ;166- undefined OFFSET XTNULL ;167- undefined OFFSET XT145 ;168- start blink/underline OFFSET XT146 ;169- stop blink/underline OFFSET XT143 ;170- start reverse/underline OFFSET XT144 ;171- stop reverse/underline OFFSET XT141 ;172- start reverse/blink/underline OFFSET XT142 ;173- stop reverse/blink/underline OFFSET XT174 ;174- start low/blink OFFSET XT175 ;175- stop low/blink OFFSET XT176 ;176- start low/reverse OFFSET XT177 ;177- stop low/reverse OFFSET XT178 ;178- start low/reverse/blink OFFSET XT179 ;179- stop low/reverse/blink OFFSET XT180 ;180- start low/underline OFFSET XT181 ;181- stop low/underline OFFSET XT182 ;182- start low/underline/blink OFFSET XT183 ;183- stop low/underline/blink OFFSET XT184 ;184- start low/underline/reverse OFFSET XT185 ;185- stop low/underline/reverse OFFSET XT186 ;186- start low/underline/reverse/blink OFFSET XT187 ;187- stop low/underline/reverse/blink OFFSET XT188 ;188- init function key line OFFSET XT189 ;189- init local msg field OFFSET XT190 ;190- init host msg field OFFSET XT191 ;191- 188, 189, 190 PAGE XT0: MOV RMAX(A4),D1 ; clear screen MOV CMAX(A4),D7 MUL D1,D7 MOV VSCR(A5),A2 1$: CLRW (A2)+ SOB D1,1$ BICL #PROTEC,JSTAT(A5) BICL #CURAGR,VTCURA(A5) BICL #CURALI,VTCURA(A5) XT1: MOV #1,ROW(A5) ; cursor home XT2: MOV #1,COL(A5) ; cursor return BICL #L25,VTCURA(A5) XTNULL: REST A0-A5,D0-D5 RTN XT3: DEC ROW(A5) ; cursor up BNE 1$ MOV #1,ROW(A5) 1$: REST A0-A5,D0-D5 RTN XT4: INC ROW(A5) ; cursor down CMM ROW(A5),RMAX(A4) JLE XEXIT BITL #PROTEC,JSTAT(A5) ; protected fields enabled? BEQ 0$ ; NO MOV #1,ROW(A5) ; YES - wrap to row 1 JMP XEXIT 0$: MOV RMAX(A4),ROW(A5) ; oops - need to scroll MOV RMAX(A4),D0 ; "move the whole mess down" MOV CMAX(A4),D7 MUL D0,D7 SUB CMAX(A4),D0 MOV VSCR(A5),A2 MOV A2,A1 ADD CMAX(A4),A1 ADD CMAX(A4),A1 1$: MOVW (A1)+,(A2)+ SOB D0,1$ XT4B: MOV RMAX(A4),D2 ; routine to clear bottom line MOV CMAX(A4),D7 MUL D2,D7 SUB CMAX(A4),D2 ADD D2,D2 MOV D2,A1 ADD VSCR(A5),A1 MOV CMAX(A4),D0 1$: CLRW (A1)+ SOB D0,1$ REST A0-A5,D0-D5 RTN XT5: DEC COL(A5) ; cursor left BNE 1$ MOV #1,COL(A5) 1$: REST A0-A5,D0-D5 RTN XT6: INC COL(A5) ; cursor right REST A0-A5,D0-D5 RTN XT9: CMM COL(A5),CMAX(A4) ; clear to EOL BGT 4$ MOV ROW(A5),D2 DEC D2 MOV CMAX(A4),D7 MUL D2,D7 ADD COL(A5),D2 DEC D2 ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 MOV CMAX(A4),D3 SUB COL(A5),D3 INC D3 1$: MOVB @A2,D1 MOVB 1(A2),D2 CLRW @A2 BITL #CURALI,VTCURA(A5) ; supposed to be low intensity? BEQ 2$ ; NO MOVB #CURALI,1(A2) ; YES - set it 2$: BITL #PROTEC,JSTAT(A5) ; is protect set? BEQ 3$ ; NO BITL #CURALI,D2 ; YES - is this protected? BNE 21$ ; YES MOVB D1,D7 ; - is this attribute? ANDB #^H70,D7 CMPB D7,#^H10 BNE 3$ 21$: MOVB D1,@A2 ; if prot. or attr. restore it MOVB D2,1(A2) 3$: ADD #2,A2 SOB D3,1$ 4$: REST A0-A5,D0-D5 RTN XT10: PUSH COL(A5) ; clear to EOS PUSH ROW(A5) 1$: MOV #^H0FF09,D1 CALL VTCRT MOV #1,COL(A5) INC ROW(A5) CMM ROW(A5),RMAX(A4) BLE 1$ POP ROW(A5) POP COL(A5) REST A0-A5,D0-D5 RTN XT11: BISL #CURALI,VTCURA(A5) ; low intensity REST A0-A5,D0-D5 RTN XT12: BICL #CURALI,VTCURA(A5) ; high intensity REST A0-A5,D0-D5 RTN XT13: BISL #PROTEC,JSTAT(A5) ; enable protected fields REST A0-A5,D0-D5 RTN XT14: BICL #PROTEC,JSTAT(A5) ; disable protected fields REST A0-A5,D0-D5 RTN XT15: MOV #1,COL(A5) ; delete line MOV ROW(A5),D0 SUB RMAX(A4),D0 NEG D0 JEQ XT4B MOV CMAX(A4),D7 MUL D0,D7 MOV ROW(A5),D2 DEC D2 MUL D2,D7 ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 MOV A2,A1 ADD CMAX(A4),A1 ADD CMAX(A4),A1 1$: MOVW (A1)+,(A2)+ SOB D0,1$ JMP XT4B XT16: MOV #1,COL(A5) ; insert line MOV ROW(A5),D0 SUB RMAX(A4),D0 NEG D0 JEQ XT4B MOV CMAX(A4),D7 MUL D0,D7 MOV ROW(A5),D2 DEC D2 MUL D2,D7 ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 MOV A2,A1 ADD CMAX(A4),A1 ADD CMAX(A4),A1 ADD D0,A1 ADD D0,A1 ADD D0,A2 ADD D0,A2 1$: MOVW -(A2),-(A1) SOB D0,1$ JMP XT9 XT21: MOV #BLINK,D3 ; blink on CALL SETAT REST A0-A5,D0-D5 RTN XT22: MOV #BLINK,D3 ; blink off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT23: BISL #CURAGR,VTCURA(A5) ; graphics on REST A0-A5,D0-D5 RTN XT24: BICL #CURAGR,VTCURA(A5) ; graphics off REST A0-A5,D0-D5 RTN XT28: JMP XT147 ; turn on blinking cursor XT29: BICL #CBLNK!CSTED!CSOLID!CUNDER,VTCURA(A5) ; turn off cursor REST A0-A5,D0-D5 RTN XT30: MOV #UNDER,D3 ; underline on CALL SETAT REST A0-A5,D0-D5 RTN XT31: MOV #UNDER,D3 ; underline off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT32: MOV #REVER,D3 ; reverse video on CALL SETAT REST A0-A5,D0-D5 RTN XT33: MOV #REVER,D3 ; reverse video off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT34: MOV #REVER!BLINK,D3 ; reverse/blink on CALL SETAT REST A0-A5,D0-D5 RTN XT35: MOV #REVER!BLINK,D3 ; reverse/blink off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN ; ----- special handling of TCRT 38-53 depending on whether or not ; the alternate (graphic) character set in use... DEFINE GRAPH1 LOC,NORM,GRAF XT'LOC: MOVB #NORM,D1 ; presume normal char BITL #CURAGR,VTCURA(A5) ; is it graphic JEQ XOUT2 ; NO MOVB #^D'LOC,D1 ; YES - use graphic char OR #CURAG2,VTCURA(A5) ; - say special graphic JMP XOUT2 ENDM GRAPH1 38,'+ ; 38- top left corner GRAPH1 39,'+ ; 39- top right corner GRAPH1 40,'+ ; 40- bottom left corner GRAPH1 41,'+ ; 41- bottom right corner GRAPH1 42,'- ; 42- top intersect GRAPH1 43,'| ; 43- right intersect GRAPH1 44,'| ; 44- left intersect GRAPH1 45,'- ; 45- bottom intersect GRAPH1 46,'- ; 46- horizontal line GRAPH1 47,'| ; 47- vertical line GRAPH1 48,'+ ; 48- intersection GRAPH1 49,'* ; 49- solid block GRAPH1 50,'* ; 50- slant block GRAPH1 51,'* ; 51- cross-hatch block GRAPH1 52,'= ; 52- double line horizontal GRAPH1 53,'| ; 53- double line vertical XT63: BISL #L25,VTCURA(A5) ; start line 25 MOV RMAX(A4),D2 ; pick up line address MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOV CMAX(A4),D1 1$: CLRW (A2)+ SOB D1,1$ MOV #1,COL(A5) REST A0-A5,D0-D5 RTN XT64: MOVB #'^,D1 ; up arrow JMP XOUT2 XT65: MOVB #'|,D1 ; down arrow JMP XOUT2 XT66: MOVB #'`,D1 ; raised dot JMP XOUT2 XT67: MOVB #'~,D1 ; end of line marker JMP XOUT2 XT68: MOVB #'[,D1 ; horizontal tab symbol JMP XOUT2 XT69: ; paragraph XT70: ; daggar XT71: ; section XT72: ; cent sign XT73: ; one-quarter XT74: ; one-half XT75: ; degree XT76: ; trademark XT77: ; copyright XT78: MOVB #40,D1 ; registered JMP XOUT2 XT79: BITL #VCON,JSTAT(A5) ; print screen BEQ 1$ ; can't if no vcrt CRT 255.,0. ; clear screen CRT 255.,37. ; video on CRT 255.,135. ; dark screen CRT 255.,132. ; clear msg line CRT 255.,28. ; cursor on CRT 255.,12. ; hi-intensity JMP DOPIC ; go do picture ; there is no return form DOPIC, drops to AMOS level... 1$: REST A0-A5,D0-D5 RTN ; ------ END OF ALPHA-MICRO DEFINED TCRT CALLS -------- GRAPH1 110,'+ ; 110 - upper left hand curve GRAPH1 111,'+ ; 111 - upper right hand curve GRAPH1 112,'+ ; 112 - lower left hand curve GRAPH1 113,'+ ; 113 - lower right hand curve ; what's 114 ??????? GRAPH1 115,'/ ; 115 - forward slash GRAPH1 116,'\ ; 116 - backward slash XT128: BISL #L25,VTCURA(A5) ; start line 25 MOV RMAX(A4),D2 ; pick up line address MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOV CMAX(A4),D1 1$: CLRW (A2)+ SOB D1,1$ MOV #1,COL(A5) REST A0-A5,D0-D5 RTN XT129: BICL #L25,VTCURA(A5) ; end line 25 MOV #1,COL(A5) REST A0-A5,D0-D5 RTN XT132: MOV RMAX(A4),D2 ; pick up line address MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOV CMAX(A4),D1 1$: CLRW (A2)+ SOB D1,1$ REST A0-A5,D0-D5 RTN XT135: BICL #NORREV,VTCURA(A5) ; screen dark REST A0-A5,D0-D5 RTN XT136: BISL #NORREV,VTCURA(A5) ; screen bright REST A0-A5,D0-D5 RTN XT137: BISL #CLICK,VTCURA(A5) ; keyclick on REST A0-A5,D0-D5 RTN XT138: BICL #CLICK,VTCURA(A5) ; keyclick off REST A0-A5,D0-D5 RTN XT139: MOV #BLANK,D3 ; blank on CALL SETAT REST A0-A5,D0-D5 RTN XT140: MOV #BLANK,D3 ; blank off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT141: MOV #REVER!BLINK!UNDER,D3 ; reverse/blink/underline on CALL SETAT REST A0-A5,D0-D5 RTN XT142: MOV #REVER!BLINK!UNDER,D3 ; reverse/blink/underline off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT143: MOV #REVER!UNDER,D3 ; reverse/underline on CALL SETAT REST A0-A5,D0-D5 RTN XT144: MOV #REVER!UNDER,D3 ; reverse/underline off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT145: MOV #BLINK!UNDER,D3 ; blink/underline on CALL SETAT REST A0-A5,D0-D5 RTN XT146: MOV #BLINK!UNDER,D3 ; blink/underline off COM D3 CALL SETAT REST A0-A5,D0-D5 RTN XT147: BICL #CSTED!CUNDER,VTCURA(A5) BISL #CBLNK!CSOLID,VTCURA(A5) REST A0-A5,D0-D5 RTN XT148: BICL #CBLNK!CUNDER,VTCURA(A5) BISL #CSTED!CSOLID,VTCURA(A5) REST A0-A5,D0-D5 RTN XT149: BISL #CBLNK!CUNDER,VTCURA(A5) BICL #CSTED!CSOLID,VTCURA(A5) REST A0-A5,D0-D5 RTN XT150: BISL #CSTED!CUNDER,VTCURA(A5) BICL #CBLNK!CSOLID,VTCURA(A5) REST A0-A5,D0-D5 RTN XT151: BISL #L25,VTCURA(A5) MOV RMAX(A4),D2 ; pick up line address MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOV CMAX(A4),D1 1$: CLRW (A2)+ SOB D1,1$ MOV #1,COL(A5) MOV #20.,D2 2$: MOVB #40,D1 CALL VOUT SOB D2,2$ REST A0-A5,D0-D5 RTN XT174: BISL #CURALI,VTCURA(A5) JMP XT21 XT175: BICL #CURALI,VTCURA(A5) JMP XT22 XT176: BISL #CURALI,VTCURA(A5) JMP XT32 XT177: BICL #CURALI,VTCURA(A5) JMP XT33 XT178: BISL #CURALI,VTCURA(A5) JMP XT34 XT179: BICL #CURALI,VTCURA(A5) JMP XT35 XT180: BISL #CURALI,VTCURA(A5) JMP XT30 XT181: BICL #CURALI,VTCURA(A5) JMP XT31 XT182: BISL #CURALI,VTCURA(A5) JMP XT145 XT183: BICL #CURALI,VTCURA(A5) JMP XT146 XT184: BISL #CURALI,VTCURA(A5) JMP XT143 XT185: BICL #CURALI,VTCURA(A5) JMP XT144 XT186: BISL #CURALI,VTCURA(A5) JMP XT141 XT187: BICL #CURALI,VTCURA(A5) JMP XT142 XT188: XT189: XT190: XT191: JMP XT132 SETAT: CMM COL(A5),CMAX(A4) ; turn attributes on/off BGT 3$ MOV ROW(A5),D0 DEC D0 MOV CMAX(A4),D7 MUL D0,D7 ADD COL(A5),D0 DEC D0 ADD D0,D0 MOV D0,A0 ADD VSCR(A5),A0 MOVB @A0,D1 ; get byte there now BMI 1$ ; already attrib MOVB #200,@A0 ; make it one 1$: TST D3 ; is new attribute a TURN ON or OFF? BMI 2$ ; OFF ORB D3,@A0 ; ON - set bits BR 3$ 2$: ANDB D3,@A0 ; OFF - reset bits 3$: INC COL(A5) ; move past attribute RTN PAGE VUNLD: SAVE A0-A5,D0-D5 ; save regs CRT 255.,14. ; disable protect CRT 255.,0. ; clear screen CRT 255.,36. ; turn off screen during repaint CRT 255.,12. ; setup hi-intensity CRT 255.,24. ; graphic off CALL VCLKOF ; tell HPO not in STATUS BITL #VCON,JSTAT(A5) ; is there a v con? BNE VUN1 ; YES CRT 255.,132. ; NO - clear line 25 MOV VTCDFL(A4),VTCURA(A5) ; - set default attributes BICL #PROTEC,JSTAT(A5) ; - set no protect JMP VUN4 ; - do normal finish up VUN1: PUSH ROW(A5) ; save cursor address PUSH COL(A5) ; ----- step 0 - null last screen byte to prevent possible ; scroll as it is restored. Send message ; line so that if unsupported will not mess ; up the rest of the screen MOV RMAX(A4),D2 ; pick up line address MOV CMAX(A4),D7 MUL D2,D7 ; times #columns/line ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 ; add in base address MOVB -3(A2),D1 ; get next-to-last char attrs ANDB #CURALI,D1 ; get intensity MOVB -2(A2),D0 ; get last byte ANDB #^H70,D0 ; check for attribute byte CMPB D0,#^H10 ; is it attribute? BEQ 1$ ; YES - leave alone CLRB -2(A2) ; NO - bare intensity MOVB D1,-1(A2) 1$: CRT 255.,128. ; send message line 2$: MOVB @A2,D1 BEQ 3$ TOUT ADD #2,A2 ; ignore attr in msg line BR 2$ 3$: CRT 255.,129. ; ----- step 1 - setup screen attributes ----- BICL #WORKLI,VTCURA(A5) ; say now hi intensity CLR ROW(A5) ; init row CLRB JWRK(A4) ; say no attributes set VUN1A: INC ROW(A5) ; advance to next row CMM ROW(A5),RMAX(A4) JHI VUN2 TSTB JWRK(A4) ; any attributes in effect? BEQ 1$ ; NO - skip intensity propagation MOV ROW(A5),D1 ; put cursor at row start RORW D1,#8. OR #1,D1 TCRT CRT 255.,9. ; erase to end of line 1$: CLR COL(A5) VUN1B: INC COL(A5) ; advance to next column CMM COL(A5),CMAX(A4) BHI VUN1A MOV ROW(A5),D2 ; compute address of char DEC D2 MOV CMAX(A4),D7 MUL D2,D7 ADD COL(A5),D2 DEC D2 ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 MOVB @A2,D1 ; get char JMI VUN1C ; attribute MOVB 1(A2),D1 ; get intensity BITB #CURALI,D1 ; this one lo intensity? BEQ 1$ ; NO BITL #WORKLI,VTCURA(A5) ; YES - already have it? BNE 2$ ; YES BISL #WORKLI,VTCURA(A5) ; NO - do now... MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,11. TSTB JWRK(A4) ; any attributes in effect? BEQ 2$ ; NO - skip intensity propagation CRT 255.,9. BR 2$ 1$: BITL #WORKLI,VTCURA(A5) ; already have hi intensity? BEQ 2$ ; YES BICL #WORKLI,VTCURA(A5) ; NO - now we do... MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,12. TSTB JWRK(A4) ; any attributes in effect? BEQ 2$ ; NO - skip intensity propagation CRT 255.,9. 2$: JMP VUN1D VUN1C: BITL #BADENA,JSTAT(A4) ; does "CRT 255.,13." work right? BEQ 0$ ; YES - use it CMM ROW(A5),RMAX(A4) ; is this last row? BNE 1$ ; NO - skip it CMM COL(A5),CMAX(A4) ; is this last col of last row? BNE 1$ ; NO - skip it 0$: CRT 255.,13. ; disable scroll 1$: MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 MOVB @A2,D3 ; get char again AND #17,D3 ; mask off bits 7,6,5,4 CLRW D0 MOVB JWRK(A4),D0 ; D0 is turn off's MOVB D3,JWRK(A4) ; D3 is turn on's TCRT ; position cursor CRT 255.,11.,SAVE ; write attributes protected ADDW D0,D0 ; do turn off's first MOVW 2$[~D0],D0 JMP 2$[~D0] 2$: WORD 18$-2$ ; nothing to turn off WORD 3$-2$ ; blank off WORD 4$-2$ ; blink off WORD 5$-2$ ; blink/blank off WORD 6$-2$ ; underline off WORD 7$-2$ ; underline/blank off WORD 8$-2$ ; underline/blink off WORD 9$-2$ ; underline/blink/blank off WORD 10$-2$ ; reverse off WORD 11$-2$ ; reverse/blank off WORD 12$-2$ ; reverse/blink off WORD 13$-2$ ; reverse/blink/blank off WORD 14$-2$ ; reverse/underline off WORD 15$-2$ ; reverse/underline/blank off WORD 16$-2$ ; reverse/underline/blink off WORD 17$-2$ ; reserse/underline/blink/blank off 3$: CRT 255.,140.,SAVE BR 18$ 4$: CRT 255.,22.,SAVE BR 18$ 6$: CRT 255.,31.,SAVE BR 18$ 8$: CRT 255.,146.,SAVE BR 18$ 10$: CRT 255.,33.,SAVE BR 18$ 12$: CRT 255.,35.,SAVE BR 18$ 14$: CRT 255.,144.,SAVE BR 18$ 16$: CRT 255.,142.,SAVE BR 18$ 5$: 7$: 9$: 11$: 13$: 15$: 17$: 18$: TCRT ; reposition cursor ADDW D3,D3 ; do turn on's now MOVW 20$[~D3],D3 JMP 20$[~D3] 20$: WORD 38$-20$ ; nothing to turn on WORD 23$-20$ ; blank on WORD 24$-20$ ; blink on WORD 25$-20$ ; blink/blank on WORD 26$-20$ ; underline on WORD 27$-20$ ; underline/blank on WORD 28$-20$ ; underline/blink on WORD 29$-20$ ; underline/blink/blank on WORD 30$-20$ ; reverse on WORD 31$-20$ ; reverse/blank on WORD 32$-20$ ; reverse/blink on WORD 33$-20$ ; reverse/blink/blank on WORD 34$-20$ ; reverse/underline on WORD 35$-20$ ; reverse/underline/blank on WORD 36$-20$ ; reverse/underline/blink on WORD 37$-20$ ; reserse/underline/blink/blank on 23$: CRT 255.,139.,SAVE BR 38$ 24$: CRT 255.,21.,SAVE BR 38$ 26$: CRT 255.,30.,SAVE BR 38$ 28$: CRT 255.,145.,SAVE BR 38$ 30$: CRT 255.,32.,SAVE BR 38$ 32$: CRT 255.,34.,SAVE BR 38$ 34$: CRT 255.,143.,SAVE BR 38$ 36$: CRT 255.,141.,SAVE BR 38$ 25$: 27$: 29$: 31$: 33$: 35$: 37$: 38$: BITL #WORKLI,VTCURA(A5) ; at low intensity anyway? BNE 40$ ; YES CRT 255.,12.,SAVE ; NO - back to hi 40$: TCRT CRT 255.,14. VUN1D: JMP VUN1B ; ----- step 2 - put data on screen ----- VUN2: BICL #WORKLI,VTCURA(A5) ; say now hi intensity BICL #WORKGR,VTCURA(A5) ; say now non graphic CRT 255.,1. ; go to home position CRT 255.,12. ; go to hi intensity CLR ROW(A5) ; init row VUN2A: INC ROW(A5) ; advance to next row BICL #WORKPO,VTCURA(A5) ; say unaligned CMM ROW(A5),RMAX(A4) JHI VUN3 CLR COL(A5) VUN2B: INC COL(A5) ; advance to next column CMM COL(A5),CMAX(A4) BHI VUN2A MOV ROW(A5),D2 ; compute address of char DEC D2 MOV CMAX(A4),D7 MUL D2,D7 ADD COL(A5),D2 DEC D2 ADD D2,D2 MOV D2,A2 ADD VSCR(A5),A2 MOVB @A2,D1 ; get char JMI VUN2D ; attrib byte MOVB 1(A2),D1 ; get cursor attrib byte BITB #CURALI,D1 ; this one lo intensity? BEQ 1$ ; NO BITL #WORKLI,VTCURA(A5) ; YES - already have it? BNE 2$ ; YES BISL #WORKLI,VTCURA(A5) ; NO - do now... MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,11. BISL #WORKPO,VTCURA(A5) ; say position current BR 2$ 1$: BITL #WORKLI,VTCURA(A5) ; already have hi intensity? BEQ 2$ ; YES BICL #WORKLI,VTCURA(A5) ; NO - now we do... MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,12. 2$: MOVB 1(A2),D1 ; get cursor attrib byte BITB #CURAGR,D1 ; this one graphic? BEQ 3$ ; NO BITL #WORKGR,VTCURA(A5) ; YES - already have it? BNE VUN2C ; YES BISL #WORKGR,VTCURA(A5) ; NO - do now... MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,23. BISL #WORKPO,VTCURA(A5) ; say position current BR VUN2C 3$: BITL #WORKGR,VTCURA(A5) ; already have graphics? BEQ VUN2C ; NO BICL #WORKGR,VTCURA(A5) ; YES - now we don't MOV ROW(A5),D1 ; compute TCRT type position into D1 RORW D1,#8. BISL COL(A5),D1 TCRT CRT 255.,24. VUN2C: MOVB @A2,D1 ; get char again ANDB #177,D1 ; remove parity CMPB D1,#40 ; is less than space? BLO VUN2D ; YES - skip it BITL #WORKPO,VTCURA(A5) ; is position current? BNE 1$ ; YES BISL #WORKPO,VTCURA(A5) ; NO - make current MOV ROW(A5),D1 RORW D1,#8. OR COL(A5),D1 TCRT 1$: MOVB @A2,D1 ; get char one last time ANDW #177,D1 ; remove parity BITB #CURAG2,1(A2) ; is the char a tcrt type graphic? BEQ 2$ ; NO ORW #^H0FF00,D1 ; YES - send graphic via TCRT TCRT JMP VUN2B 2$: TOUT ; send to screen JMP VUN2B VUN2D: BICL #WORKPO,VTCURA(A5) ; note postion not current JMP VUN2B ; when chars skipped. ; ----- step 3 - restore cursor position ----- VUN3: POP COL(A5) POP ROW(A5) MOV ROW(A5),D1 RORW D1,#8. BISL COL(A5),D1 TCRT ; ----- step 4 - restore cursor attributes ----- VUN4: CRT 255.,12. ; to high intensity BITL #CURALI,VTCURA(A5) ; at lo intensity? BEQ 1$ ; NO CRT 255.,11. ; YES 1$: CRT 255.,24. ; out of graphic mode BITL #CURAGR,VTCURA(A5) ; at graphic? BEQ 20$ ; NO CRT 255.,23. ; YES 20$: CRT 255.,29. ; turn cursor off BITL #CBLNK!CSTED!CSOLID!CUNDER,VTCURA(A5) ; want cursor on? BEQ VUN5 ; NO CRT 255.,28. ; YES - turn it on BITL #CSOLID,VTCURA(A5) ; is this solid cursor? BEQ 22$ ; NO BITL #CBLNK,VTCURA(A5) ; is this blinking? BEQ 21$ ; NO CRT 255.,147. ; YES - make it do that BR VUN5 21$: CRT 255.,148. BR VUN5 22$: BITL #CBLNK,VTCURA(A5) BEQ 23$ CRT 255.,149. BR VUN5 23$: CRT 255.,150. ; ----- step 5 - restore keyclick and dark/bright status ----- VUN5: CRT 255.,138. ; turn keyclick off BITL #CLICK,VTCURA(A5) BEQ 25$ CRT 255.,137. ; turn on if needed 25$: CRT 255.,135. ; make screen dark BITL #NORREV,VTCURA(A5) BEQ VUN6 CRT 255.,136. ; make screen bright if needed ; ----- step 6 - restore protect status ----- VUN6: BITL #PROTEC,JSTAT(A5) ; was protect enabled? BEQ VUNFIN ; NO CRT 255.,13. ; YES - re-enable ; ----- final step - turn video back on, wait for all terminal ; I/O to complete, and set POO so that tabs ; will be done correctly. VUNFIN: CRT 255.,37. ; turn video on MOV JTRM(A4),A3 ; point to my TRMDEF 1$: SLEEP #100 BITW #T$OIP,@A3 ; is it still busy? BNE 1$ ; YES - wait for it TST T.OQX(A3) ; is output queued? BNE 1$ ; YES - wait for it BITL #VCON,JSTAT(A5) ; is there a v con? BEQ 2$ ; NO MOV COL(A5),D2 ; get correct position DEC D2 MOVW D2,T.POO(A3) ; update so TRMSER does TABs right 2$: REST A0-A5,D0-D5 ; restore regs and return RTN PAGE PRTPIC: BITL #VCON,JSTAT(A5) ; is there a v con? BNE PP1 ; YES RTN ; NO - immed exit PP1: SAVE A0-A5,D0-D5 ; save regs USRFRE A0 ; save end of memory MOV A5,A3 ; current job addressed by A3 here... MOV JME(A4),A5 ; A5 used to address private DDB CRT 23.,1 MOV A0,JDDB+D.DDB(A5) ; stash end of memory MOVB #1,JDDB+D.FLG(A5) ; setup DDB INIT JDDB(A5) ; init it JNE PP10 ; failed! LOOKUP JDDB(A5) ; is it already there? BNE PP2 ; NO DSKDEL JDDB(A5) ; YES - delete it PP2: OPENO JDDB(A5) ; open pic file JNE PP11 ; BARF CLRW JWRK+2(A4) ; output position CLRW JWRK+4(A4) ; saved-up spaces CLRW JWRK+6(A4) ; saved-up tabs IF NE,DEBUG CMMW #[TRM],JDDB+D.DEV(A5) ; output to TRM: ? BEQ PP2A ; YES - skip header ENDC LEA A2,JDDB(A5) ; send header... MOV RMAX(A4),D1 ; output row max INC D1 ; + 1 for row 25 DCVT 0,OT$DDB MOVB #^H2C,D1 ; then a comma CALL BYTOUT MOV CMAX(A4),D1 ; then column max DCVT 0,OT$DDB MOVB #^H2C,D1 ; then a comma CALL BYTOUT MOV ROW(A3),D1 ; then cursor row DCVT 0,OT$DDB MOVB #^H2C,D1 ; then a comma CALL BYTOUT MOV COL(A3),D1 ; then cursor column DCVT 0,OT$DDB MOVB #15,D1 ; finally CRLF CALL BYTOUT MOVB #12,D1 CALL BYTOUT PP2A: MOV VSCR(A3),A2 ; set begin addr MOV RMAX(A4),D0 ; set # lines INC D0 ; + 1 for line 25 MOV CMAX(A4),D3 ; set # chars PP3: MOVB (A2)+,D1 ; output a char BGT 1$ ; attrib or null? MOVB #40,D1 ; YES - make space 1$: BITB #CURAG2,@A2 BEQ 2$ LEA A6,GRTBL-38. ADD D1,A6 MOVB @A6,D1 2$: CALL ENTAB ADD #1,A2 SOB D3,PP3 MOVB #15,D1 CALL ENTAB MOVB #12,D1 CALL ENTAB MOV CMAX(A4),D3 SOB D0,PP3 ; go do next line (unless done) IF NE,DEBUG CMMW #[TRM],JDDB+D.DEV(A5) ; output to TRM: ? BNE PP3A ; NO - do attribute stuff MOVB #14,D1 ; YES - send final form feed CALL BYTOUT JMP PP5 ; - and skip attr stuff ENDC PP3A: MOV JCUR(A4),A3 ; recover pointer to cur job MOV VSCR(A3),A2 ; set begin addr MOV RMAX(A4),D0 ; set # lines MOVB #'@,JWRK(A4) ; set initial attribute of none MOV CMAX(A4),D3 ; set # chars BR PP4 PATBL: ASCII /@ABCDEFGHIJKLMNO/ ; attribute indicators... EVEN GRTBL: ASCII /++++-||--|+***=|/ ; printables for tcrt graphics ASCII / / ; 54 ASCII / / ; 70 ASCII / / ; 86 ASCII $ ++++ /\ $ ; 102 (110-113, 115-116) EVEN PP4: MOVB @A2,D1 ; output a char BMI 1$ ; NULL - use last one MOVB JWRK(A4),D1 ; NO - same as last one... BR 2$ 1$: ANDW #17,D1 ; mask off high bits LEA A1,PATBL[~D1] ; point to attribute table MOVB @A1,JWRK(A4) ; get it BR 4$ 2$: BITB #CURALI,1(A2) ; low intensity on? BEQ 3$ ; NO ORB #40,D1 ; YES - turn it on 3$: CMPB D1,#'@ ; this HI-inten/nothing else? BNE 5$ ; NO 4$: MOVB #40,D1 ; YES - let it be a space 5$: CALL ENTAB ADD #2,A2 SOB D3,PP4 MOVB #15,D1 CALL ENTAB MOVB #12,D1 CALL ENTAB MOV CMAX(A4),D3 SOB D0,PP4 ; go do next line (unless done) MOVB #15,D1 ; extra line for line 25 CALL ENTAB MOVB #12,D1 CALL ENTAB PP5: CLOSE JDDB(A5) ; close file MOV JDDB+D.DDB(A5),A0 ; delete buffer CLR -4(A0) REST A0-A5,D0-D5 BITL #CTLMOD,JSTAT(A4) ; are we at status screen? BEQ 1$ ; NO CRT 23.,1 TYPE CRT 255.,9. 1$: RTN PP10: CLR -4(A0) JMP ALC3 PP11: CLR -4(A0) REST A0-A5,D0-D5 RTN ENTAB: CMPB D1,#40 ; Routine to Entab output and remove BLO 4$ ; trailing spaces... BNE 2$ ; (for PIC files) INCW JWRK+4(A4) INCW JWRK+2(A4) MOVW JWRK+2(A4),D1 AND #7,D1 BEQ 1$ RTN 1$: INCW JWRK+6(A4) CLRW JWRK+4(A4) RTN 2$: TSTW JWRK+6(A4) BEQ 25$ PUSH D1 MOVB #11,D1 CALL BYTOUT POP D1 DECW JWRK+6(A4) BR 2$ 25$: TSTW JWRK+4(A4) BEQ 3$ PUSH D1 MOVB #40,D1 CALL BYTOUT POP D1 DECW JWRK+4(A4) BR 25$ 3$: CLRW JWRK+4(A4) CLRW JWRK+6(A4) INCW JWRK+2(A4) CALL BYTOUT RTN 4$: CMPB D1,#11 BEQ 1$ CLRW JWRK+2(A4) CLRW JWRK+4(A4) CLRW JWRK+6(A4) JMP BYTOUT PAGE ALLCON: BITL #VCON,JSTAT(A5) ; already have it? BEQ 1$ ; NO RTN 1$: SAVE A0-A5,D0-D5 ; save regs CRT 23.,1 CALL PSCAN ; init picture numbers MOV RMAX(A4),D1 ; figure out how much storage MOV CMAX(A4),D7 MUL D1,D7 ; rows x columns ADD CMAX(A4),D1 ; get a 'line 25' too ADD D1,D1 ; get 2 bytes for each char PUSH D1 ; ask for it PUSH GETMEM @SP BNE ALC2 ; msg if no memory POP A3 ; else get addr into A3 POP MOV A3,VSCR(A5) ; stash addr SUB #10,A3 ; backup to mem mod flags BISW #FIL,@A3 ; set permanent MOV VNAME(A5),2(A3) ; set name MOVW #[CON],6(A3) ; set extension BISL #VCON,JSTAT(A5) ; set "have v con" BICL #PROTEC,JSTAT(A5) ; turn off protected fields MOV VTCDFL(A4),VTCURA(A5) ; set default attributes JMP XT0 ; exit thru "clear screen" ALC2: POP ; ERROR EXIT POP ALC3: CRT 23.,1 CRT 255.,9. TYPE REST A0-A5,D0-D5 RTN RELCON: BITL #VCON,JSTAT(A5) ; have a virtual screen? BNE 1$ ; YES RTN 1$: PUSH ; free screen PUSH VSCR(A5) ; at wherever it is DELMEM @SP POP POP BICL #VCON,JSTAT(A5) ; no v con now... CALL ADJMEM ; adjust pointers after DELMEM RTN EVEN END