.TITLE TCFLO .ENABL LC ; ; AUTHOR: S.C. Cribbs (Technical Services Branch) ; Atomic Energy of Canada Ltd. Pinawa, Manitoba ; 83/05/14 ; version 2 .NLIST ; Conditional Assembly Definitions ; NHD = 1 ;Symbol should be defined for NHD division ; ESC = 33 ;Numeric value of the Escape Sequence Introducer ; SZEM4 = 10. ;Default string length for MSG4 message buffer ; VT$.$ = 1 ;Define for default video terminal features ; VT125 = 1 ;Define for VT125 specific features ; LA$.$ = 1 ;Define for default hardcopy terminal features ; LA34 = 1 ;Define for LA34 specific features (LA12,LA100) .MACRO SYMNZ SYM,VSYM,TEXT .IIF NE SYM, SYM = VSYM ;TEXT .ENDM ;SYMNZ .LIST .NLIST BEX,CND,MC .LIST ME ; The following symbols have been defined for this assembly: .IIF NDF NHD, NHD = 0 .IF EQ NHD NHD = 0 ;Division requests are Extended Instruction Set (EIS) .IFF NHD = 1 ;Division requests are Non_Hardware_Dependent (NHD) .ENDC ;NE NHD .IIF NDF ESC, ESC = 33 SYMNZ ESC,\ESC, .IIF NDF SZEM4, SZEM4 = 10. .IIF LE SZEM4, SZEM4 = 10. SYMNZ SZEM4,\SZEM4, .IIF NDF VT$.$, VT$.$ = 0 .IIF NE VT$.$, VT$.$ = 1 ;Support basic VT100 Escape Sequences .IIF NDF VT125, VT125 = 0 .IIF NE VT125, VT125 = 1 ;Support VT125 Escape Sequences .IIF NDF LA$.$, LA$.$ = 0 .IIF NE LA$.$, LA$.$ = 1 ;Support basic LA120 Escape Sequences .IIF NDF LA34, LA34 = 0 .IIF NE LA34, LA34 = 1 ;Support LA34 Escape Sequences (LA12,LA100) .IF NE VT125 .IIF EQ VT$.$, VT$.$ = 1 .ENDC ;NE VT125 .IF NE LA34 .IIF EQ LA$.$, LA$.$ = 1 .ENDC ;NE LA34 .IIF EQ VT$.$ + LA$.$, .END ;ERROR -- No terminal type specified .GLOBL KPAM,KPNM,NEL,IND,CRLF,SCS0,SCS1,NWLNEM,LNEFDM .GLOBL HTBSTC,HTBCLC,HTBCLA,SCSUK,SCSUSA,RPTID,SETTBM .IF NE VT$.$ .GLOBL SAVCUR,RESCUR,RI,RIS,ALIGND,BIGTOP,BIGBOT,DWL,SWL .GLOBL CLRALL,CLRTOP,CLRBOT,LLEDS,CLRLIN,CLRBEG,CLREND,SCSGRF .GLOBL SM,RM,CUP,CUU,CUD,CUF,CUB,ANSI,SGR,SCSAL1,SCSAL2,RPTCP .GLOBL GPON,GPOFF,HRDCPY .ENDC ;NE VT$.$ .IF NE VT125 .GLOBL RPTDS,DCS125,DCS105,DCSDIF,MDCPY,GIMOAP,GIMOHC,RGSTRM .GLOBL SS2,SS3 .ENDC ;NE VT125 .IF NE LA$.$ .GLOBL SCSFIN,SCSNOR,SCSSWE,SCSGER,SCSFRA,VPA,VPR,HPA,HPR,HTBSTS .GLOBL VTBSTC,VTBSTS,VTBCLC,VTBCLA,SHPTCH,SVPTCH,SETLRM,SETLPP .IF NE LA34 .GLOBL SCSQUE,PLD,PLU .IIF EQ VT125, .GLOBL DCSDIF,RGSTRM,CUU,RI,SCSGRF .ENDC ;NE LA34 .ENDC ;NE LA$.$ .GLOBL OUTSTR .PSECT USER$D RW,D,LCL,REL,CON ;Protect from USR swapping MSG1: .ASCII <16><200> MSG2: .ASCII /8/<200> MSG2A: .ASCII <15><12><200> .IF NE VT$.$ MSG3: .ASCII /#8/<200> .ENDC ;NE VT$.$ MSG3A: .ASCII /(A/<200> MSG4: .ASCII /[/ .BLKB SZEM4 ENDM4: .BLKB 4 .IF NE VT125 + LA34 MSG4A: .ASCII /P0p/<200> .ENDC ;NE VT125 + LA34 .EVEN .page .PSECT USER$I RW,I,LCL,REL,CON ;Pure code .NLIST ME .LIST MC ; ;********************************************************************** ; SCS0: MOV #17,R0 ;Shift to Character Set 0 BR OUTP1 SCS1: MOV #16,R0 ;Shift to Character Set 1 BR OUTP1 OUTP1: MOV R0,MSG1 MOV #MSG1,R0 JMP OUTSTR .page ; ;********************************************************************** ; .IF NE VT$.$ SAVCUR: MOVB #'7,R0 ;SAVe CURsor & attributes BR OUTP2 RESCUR: MOVB #'8,R0 ;REStore CURsor & attributes BR OUTP2 RIS: MOVB #'c,R0 ;Reset to Initial State BR OUTP2 ANSI: MOVB #'<,R0 ;set ANSI mode BR OUTP2 .ENDC ;NE VT$.$ KPAM: MOVB #'=,R0 ;KeyPad Application Mode BR OUTP2 KPNM: MOVB #'>,R0 ;KeyPad Numeric Mode BR OUTP2 .IF NE VT$.$ + LA34 RI: MOVB #'M,R0 ;Reverse Index (move up) BR OUTP2 .ENDC ;NE VT$.$ + LA34 NEL: MOVB #'E,R0 ;NEw Line BR OUTP2 IND: MOVB #'D,R0 ;INDex (move down) BR OUTP2 HTBSTC: MOVB #'H,R0 ;Horizontal TaB SeT at Current posn. BR OUTP2 .IF NE LA$.$ VTBSTC: MOVB #'J,R0 ;Vertical TaB SeT at Current position BR OUTP2 .ENDC ;NE LA$.$ .IF NE LA34 PLD: MOVB #'K,R0 ;Partial Line Down (LA34) BR OUTP2 PLU: MOVB #'L,R0 ;Partial Line Up (LA34) BR OUTP2 .ENDC ;NE LA34 .IF NE VT125 + LA34 RGSTRM: MOV #'\,R0 ;REGIS string terminator(VT125 & LA34) BR OUTP2 .ENDC ;NE VT125 + LA34 .IF NE VT$.$ GPON: MOVB #'1,R0 ;Graphics Processor on BR OUTP2 GPOFF: MOVB #'2,R0 ;Graphics Processor off BR OUTP2 .ENDC ;NE VT$.$ .IF NE VT125 SS2: MOVB #'N,R0 ;Single Shift 2; Select G2 char. set BR OUTP2 SS3: MOVB #'O,R0 ;Single Shift 3; Select G3 char. set BR OUTP2 .ENDC ;NE VT125 OUTP2: MOVB R0,MSG2+1 MOV #MSG2,R0 JMP OUTSTR CRLF: MOV #MSG2A,R0 ;Output carriage return - linefeed JMP OUTSTR .page .IF NE VT$.$ ; ;*********************************************************************** ; HRDCPY: MOVB #'7,R0 ;HaRD CoPY (Dump screen to printer) BR OUTP3 ; (VT100) ALIGND: MOVB #'8,R0 ;ALIGN Display (fill screen with E's) BR OUTP3 BIGTOP: MOVB #'3,R0 ;BIG TOP (of double height line) BR OUTP3 BIGBOT: MOVB #'4,R0 ;BIG BOTtom (of double height line) BR OUTP3 DWL: MOVB #'6,R0 ;Double Width Line BR OUTP3 SWL: MOVB #'5,R0 ;Single Width Line BR OUTP3 OUTP3: MOVB R0,MSG3+2 MOV #MSG3,R0 JMP OUTSTR .page .ENDC ;NE VT$.$ ; ;*********************************************************************** ; SCSUK: MOV #'A,R0 ;Designate United Kingdom set BR OUTP3A SCSUSA: MOV #'B,R0 ;Designate United States set BR OUTP3A .IF NE LA$.$ SCSFIN: MOV #'C,R0 ;Designate Finnish set BR OUTP3A SCSNOR: MOV #'E,R0 ;Designate Norwegian set BR OUTP3A SCSSWE: MOV #'H,R0 ;Designate Swedish set BR OUTP3A SCSGER: MOV #'K,R0 ;Designate German set BR OUTP3A .IF NE LA34 SCSQUE: MOV #'Q,R0 ;Designate Quebec (Canadien) set BR OUTP3A ; (LA34) .ENDC ;NE LA34 SCSFRA: MOV #'R,R0 ;Designate French set BR OUTP3A .ENDC ;NE LA$.$ .IF NE VT$.$ + LA34 SCSGRF: MOV #'0,R0 ;Designate Graphics & Line set BR OUTP3A ; (VT100,VT125,LA34) .ENDC ;NE VT$.$ + LA34 .IF NE VT$.$ SCSAL1: MOV #'1,R0 ;Designate Alternate ROM #1 set BR OUTP3A SCSAL2: MOV #'2,R0 ;Designate Alternate ROM #2 set BR OUTP3A .ENDC ;NE VT$.$ OUTP3A: MOV #MSG3A+3,R3 MOVB R0,-(R3) MOVB #'(,-(R3) TST (R5)+ BEQ 1$ CMP #-1,(R5) BEQ 1$ TST @(R5)+ BEQ 1$ MOVB #'),@R3 1$: MOV #MSG3A,R0 JMP OUTSTR .page ; ;*********************************************************************** ; .IF NE VT$.$ CLRALL: MOVB #'2,R0 ;CLeaR ALL of the screen BR ED CLRTOP: MOVB #'1,R0 ;CLeaR the TOP of the screen BR ED CLRBOT: MOVB #'0,R0 ;CLeaR the BOTtom of the screen BR ED ED: MOVB #'J,R1 ;[Erase the Display] BR CONST CLRLIN: MOVB #'2,R0 ;CLeaR LINe BR EL CLRBEG: MOVB #'1,R0 ;CleaR BEGinning of line BR EL CLREND: MOVB #'0,R0 ;CLeaR END of the line BR EL EL: MOVB #'K,R1 ;[Erase Line] BR CONST ;not Fortran callable .ENDC ;NE VT$.$ HTBCLC: MOV #'0,R0 ;Horizontal TaB CLear (Current column) BR TB HTBCLA: MOV #'3,R0 ;Horizontal TaB CLear (All tabs) BR TB .IF NE LA$.$ VTBCLC: MOV #'1,R0 ;Vertical TaB CLear (Current column) BR TB VTBCLA: MOV #'4,R0 ;Vertical TaB CLear (All tabs) BR TB .ENDC ;NE LA$.$ TB: MOVB #'g,R1 BR CONST RPTID: MOV #'0,R0 ;Request device identification report MOV #'c,R1 BR CONST .IF NE VT$.$ RPTDS: MOV #'5,R0 ;Request device status report BR RPT RPTCP: MOV #'6,R0 ;Request cursor position report BR RPT RPT: MOV #'n,R1 .ENDC ;NE VT$.$ CONST: MOV #MSG4+2,R3 ;Point to location to be modified MOVB R0,(R3)+ MOVB R1,(R3)+ JMP OUTP4 NWLNEM: MOV #'h,R2 ; implies , BR LFNL LNEFDM: MOV #'l,R2 ; implies just LFNL: MOV #MSG4+2,R3 MOVB #'2,(R3)+ MOVB #'0,(R3)+ MOVB R2,(R3)+ JMP OUTP4 .IF NE VT125 GIMOAP: MOV #'0,R0 ;Graphic IMage Output to Aux. Port BR GIM ; (VT125) GIMOHC: MOV #'2,R0 ;Graphic IMage Output to Host Computer BR GIM ; (VT125) GIM: MOV #MSG4+2,R3 MOVB #'?,(R3)+ MOVB R0,(R3)+ MOVB #'i,(R3)+ MOVB #200,(R3)+ MOV #MSG4,R0 JMP OUTSTR .ENDC ;NE VT125 .page ; ;********************************************************************** ; .IF NE VT$.$ SM: MOVB #'h,-(SP) ;Set Mode BR M RM: MOVB #'l,-(SP) ;Reset Mode BR M M: ;[Mode] - not Fortran callable MOV #9.,R2 ;Highest defined for VT100 & VT125 MOV #MSG4+2,R3 ;Point to first volatile byte MOVB #'?,(R3)+ BR LD1ARG .ENDC ;NE VT$.$ .IF NE VT$.$ + LA34 CUU: MOVB #'A,-(SP) ;CUrsor Up BR CU .ENDC ;NE VT$.$ + LA34 .IF NE VT$.$ CUD: MOVB #'B,-(SP) ;CUrsor Down BR CU CUF: MOVB #'C,-(SP) ;CUrsor Forward BR CU CUB: MOVB #'D,-(SP) ;CUrsor Backward BR CU .ENDC ;NE VT$.$ .IF NE VT$.$ + LA34 CU: MOV #132.,R2 ;Maximum column number MOV #MSG4+2,R3 ;Point to first volatile byte BR LD1ARG .ENDC ;NE VT$.$ + LA34 .IF NE LA$.$ SHPTCH: MOVB #'w,-(SP) ;Set Horizontal PiTCH MOV #8.,R2 ;Highest defined value BR PCOMN SVPTCH: MOVB #'z,-(SP) ;Set Vertical PiTCH MOV #6.,R2 BR PCOMN VPA: MOVB #'d,-(SP) ;Vertical Position Absolute MOV #168.,R2 BR PCOMN VPR: MOVB #'e,-(SP) ;Vertical Position Relative MOV #256.,R2 BR PCOMN HPA: MOVB #'`,-(SP) ;Horizontal Position Absolute BR HP HPR: MOVB #'a,-(SP) ;Horizontal Position Relative HP: MOV #216.,R2 PCOMN: MOV #MSG4+2,R3 BR LD1ARG SETLPP: MOV #'t,-(SP) ;SET the number of Lines Per Page MOV #168.,R2 MOV #MSG4+2,R3 BR LD1ARG .ENDC ;NE LA$.$ .IF NE VT125 MDCPY: MOV #'i,-(SP) ;MeDia CoPY (VT125) MOV #7,R2 ;Highest defined parameter MOV #MSG4+2,R3 BR LD1ARG .ENDC ;NE VT125 .page ; ;*********************************************************************** ; .IF NE VT$.$ CUP: MOVB #'H,-(SP) ;CUrsor Position (relative to origin) MOV #132.,R2 ;Define maximum argument value BR LD2ARG .ENDC ;NE VT$.$ .IF NE LA$.$ SETLRM: MOVB #'s,-(SP) ;SET Left & Right Margins MOV #216.,R2 BR LD2ARG .ENDC ;NE LA$.$ SETTBM: MOVB #'r,-(SP) ;SET Top & Bottom Margins .IF NE LA$.$ MOV #168.,R2 .IFF MOV #24.,R2 ;Only 24 lines on a VT100 & VT125 .ENDC ;NE LA$.$ BR LD2ARG .page .IF NE VT$.$ ; ;*********************************************************************** ; LLEDS: MOVB #'q,-(SP) ;Light LEDS (on keyboard) MOV #4,R2 ;There's only four on terminal BR LD4ARG SGR: MOVB #'m,-(SP) ;Select Graphic Rendition MOV #7,R2 ;Highest defined attribute type BR LD4ARG .ENDC ;NE VT$.$ .IF NE LA$.$ ; ;*********************************************************************** ; HTBSTS: MOVB #'u,-(SP) ;Horizontal TaB SeT Specified MOV #216.,R2 BR TBSTS VTBSTS: MOVB #'v,-(SP) ;Vertical TaB Set Specified MOV #168.,R2 TBSTS: MOV #131,R1 BR LDACMN .ENDC ;NE LA$.$ .page LD1ARG: MOV #1,R1 ;Encode one FORTRAN argument BR ENCARG LD2ARG: MOV #2,R1 ;Encode two FORTRAN arguments BR LDACMN LD4ARG: MOV #4,R1 ;Encode up to four FORTRAN arguments LDACMN: MOV #MSG4+2,R3 ;Point to parameter position ; ; R5 -> Points to FORTRAN argument block ; R3 -> User's buffer for ASCII output ; R2 -> Highest acceptable value for this argument ; R1 -> Maximum number of arguments to consider ; ; NOTE: Negative or null arguments are replaced by an ; ASCII zero. Illegally high arguments are replaced ; by the user supplied highest acceptable value. ; ENCARG: MOV (R5)+,R4 ;Move no. of args. to R4 CMPB R1,R4 ;Does argument count exceed limit? BGE 1$ ;Branch if not MOV R1,R4 ;Yes, impose a limit 1$: TSTB R4 ;Look at count of arguments BLE 3$ ;Return default if no arguments 2$: CMP #-1,@R5 ;Is it a FORTRAN null argument BEQ 3$ ;Yes, just return default value MOV @(R5)+,R1 ;Get the argument value BGT 4$ ;Branch if greater than zero 3$: MOVB #'0,(R3)+ ;ASCII code zero is the default BR 10$ ;Take exit 4$: CMP R2,R1 ;Compare against highest OK value BGE 5$ ;Branch if argument is smaller MOV R2,R1 ;Overwrite argument value 5$: MOVB #-1,-(SP) ;Install "empty" marker on stack 6$: CLR R0 ;Initialize H.O. dividend .IF NE NHD 7$: SUB #12,R1 ;# Subtract by 10's BMI 8$ ;# Sub below 0? INC R0 ;# Count 'em. BR 7$ ;# And try again. 8$: ADD #12,R1 ;# Restore remainder. .IFF DIV #10.,R0 ;Decimal scale of argument (EIS) .ENDC ;NE NHD ADD #'0,R1 ;Convert remainder to ASCII MOVB R1,-(SP) ;Save on stack MOV R0,R1 ;Place quotient in L.O. dividend BNE 6$ ;Loop until zero 9$: MOVB (SP)+,(R3)+ ;Install characters in user's buffer BPL 9$ ;Loop till stack empty DEC R3 ;Back up over trailing "377 byte 10$: MOVB #';,(R3)+ ;Install a parameter separator CMP #ENDM4,R3 ;Reached end of available buffer yet? BLO 11$ ;If so, terminate string now! DECB R4 ;Count down argument count BGT 2$ ;Loop till done 11$: MOVB (SP)+,-1(R3) OUTP4: MOVB #200,(R3)+ ;Load string output terminator MOV #MSG4,R0 JMP OUTSTR .IF NE VT125 + LA34 .page ; ;*********************************************************************** ; DCSDIF: MOV #'q,-(SP) ;Display Image Format (VT125 or LA34) BR DCS1 .IF NE VT125 DCS105: MOV #'t,-(SP) ;Emulate VT105 Graphics terminal BR DCS1 DCS125: MOV #'p,-(SP) ;Switch into VT125 graphics mode TST (R5)+ MOV @(R5)+,R0 BPL DCS2 .ENDC ;NE VT125 DCS1: CLR R0 DCS2: BISB #'0,R0 ;Make ASCII MOV #MSG4A+2,R3 MOVB R0,(R3)+ MOVB (SP)+,(R3)+ MOV #MSG4A,R0 JMP OUTSTR .ENDC ;NE VT125 + LA34 .END