;BLKDSP.LIT
;
;
;4/24/84           STEVEN G. MCNAUGHTON & RICH EAKIN
;                QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
; ***********************************************************************
; *                                                                     *
; * Format for use is BLKDSP <DSKn:> BLOCK                              *
; *                                                                     *
; * If no device is enter the users log in device is defaulted.         *
; *                                                                     *
; *                                                                     *
; * Enter numbers according to the current terminal attributes (either  *
; * octal or hex). If Hex is set and the number being entered begins    *
; * with a character A thru F; then that number must be proceeded with  *
; * a zero (0).                                                         *
; *                                                                     *
; ***********************************************************************


; ***********************************************************************
; *                   BLOCK DISPLAY COMMAND LIST                                *
; ***********************************************************************
; *                                                                     *
; * ^T (CNTRL T) - Scroll display to next page                          *
; *                                                                     *
; * ^R (CNTRL R) - Scroll display to previous page                      *
; *                                                                     *
; * ^H (CNTRL H) - Word outline left one word                           *
; * Left arrow   -   "     "     "    "    "                            *
; *                                                                     *
; * ^L (CNTRL L) - Word outline right one word                          *
; * Right arrow  -   "     "      "    "    "                           *
; *                                                                     *
; * ^J (CNTRL J) - Word outline down one line                           *
; * Down arrow   -   "     "     "    "    "                            *
; *                                                                     *
; * ^K (CNTRL K) - Word outline up one line                             *
; * Up arrow     -   "     "    "   "   "                               *
; *                                                                     *
; * Q  - Quit (exit editor - does not rewrite updates to disk)          *
; *                                                                     *
; ***********************************************************************

; ***********************************************************************
; *            Program Development and Edit History                     *
; ***********************************************************************
; 100. - BASIC BLOCK PRINT TO TERMINAL  [SGM]
; 101. - UPGRADED PAGE FLIP AND EXIT ROUTINE  [SGM]
; 102. - ADDED WORD POSITIONING AND OUTLINING ROUTINE  [SGM]
; 103. - ADDED INSTANT TRANSLATION ROUTINE  [SGM]
; 104. - UPGRADED INSTANT TRANSLATION TO INCLUDE DECIMAL WORD TRANSLATION  [SGM]
; 105. - ADDED VERSION AND MODULE LOADING DISPLAY  [SGM]
; 106. - ADDED LONGWORD TRANSLATION ROUTINE  [SGM]
; 107. - UPGRADED INPUT - ALL INPUT ON COMMAND LINE  [SGM]
; 108. - HEX VERSUS OCTAL FORMAT DISPLAY UPGRADE  [SGM]
; 109. - CORRECTED BLOCK NUMBER RANGE CHECK FOR DEVICES WITH OVER 32K
;        BYTES PER DISK  [SGM]  5/18/84
; ***********************************************************************


SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV


OFINI
OFDEF   IDDB,D.DDB                      ;DUMMY FILE DDB
OFSIZ   IMPSIZ


; ***********************************************************************
; *                                                                     *
; *                      MACRO DEFINITION AREA                          *
; *                                                                     *
; ***********************************************************************

DEFINE  SPACE   ARG,ARG2                        ;PRINT ARG # OF SPACES,
       SAVE    D1,D2,D3                        ;  ARG2 # OF TIMES
       CLR     D1
       CLR     D2
       CLR     D3
       MOVW    #ARG2,D3
       TSTB    D5
       BNE     5$$
       SUBW    #2,D3
       TSTW    D3
       BGE     5$$
       MOVW    #0,D3
5$$:    MOVW    #ARG,D2
       MOVB    #40,D1
10$$:
       TTY
       SUBW    #1,D2
       TSTW    D2
       BNE     10$$
20$$:
       TSTW    D3
       BEQ     30$$
       SUBW    #1,D3
       TSTW    D3
       BEQ     30$$
       MOVW    #ARG,D2
       BR      10$$

30$$:   REST    D1,D2,D3
ENDM

; ***********************************************************************
; *                                                                     *
; *                        SYMBOL EQUATE AREA                           *
; *                                                                     *
; ***********************************************************************

WDSPC=4                         ;WORD DISPLAY COUNT     (6 FOR OCTAL)
BTRNC=2                         ;TRANSLATION DSP COUNT  (3 FOR OCTAL)
ARG2=2                          ;SPACE LOOP TALLY       (0 FOR OCTAL)


VMAJOR=1.                       ;PROGRAM HEADER (VERSION NUMBER)
VMINOR=1.
VSUB=1.
VEDIT=109.
VWHO=1.

HEADER:
       PHDR    -1,PV$RSM!PV$WSM,PH$REE!PH$REU

TOP:
       GETIMP  IMPSIZ,A5,EXIT          ;GET SOME IMPURE SPACE
       JOBIDX  A3
       MOVW    JOBTYP(A3),D1
       ANDW    #J.HEX,D1
       BEQ     OCTPTH

;DEFINE HEX SCREEN FORMAT
HEXPTH:
       MOVB    #1,D5                   ;QUICK STORAGE FOR DSPFLG
       BR      RESPRG


;DEFINE OCTAL SCREEN FORMAT
OCTPTH:
       MOVB    #0,D5                   ;QUICK STORAGE FOR DSPFLG

RESPRG:
       MOVW    #177435,D1              ;CURSOR OFF
       TCRT
       CLRW    D1
       CTRLC   EXIT
       LEA     A3,PAGENO
       MOVW    #1,(A3)
       MOV     A2,D2
       LEA     A3,ASCBUF               ;A3 POINTS TO ASCII BUFFER SPACE
       BYP                             ;BYPASS ANY BLANKS ON COMMAND LINE
       LIN                             ;END OF LINE?
       JEQ     CERROR                  ;YES ! *ERROR* ALL INFO ON COMMAND LINE

NUMCHK:
       CTRLC   EXIT
       NUM                             ;IS THE FIRST CHAR NUMERIC?
       JEQ     INPBLK                  ;YES ! GET THE BLOCK NUMBER
INLINE:                                 ;NO ! GET THE DEVICE AND DRIVE INFO NOW
       CTRLC   EXIT
       MOVB    (A2)+,(A3)+             ;FIRST BYTE ON COMMAND LINE TO ASCII BUFFER
       MOVB    (A2)+,(A3)+             ;SECOND BYTE ON COMMAND LINE
       MOVB    (A2)+,(A3)              ;THIRD BYTE ON COMMAND LINE
       LEA     A3,INDRV                ;LOAD THE DRIVE STORAGE AREA
       MOVB    (A2)+,(A3)+             ;FOURTH BYTE ON COMMAND LINE TO DRIVE
       BYP                             ;BYPASS ANY BLANKS
       LIN                             ;END OF LINE?
       JEQ     CERROR                  ;*ERROR* WHERE'S THE COLON?
       MOVB    (A2),D1                 ;CHECK THE COMMAND LINE FOR A COLON
       CMPB    D1,#':                  ;IS IT A COLON (END OF DEV AND DRV)
       JEQ     PCKIT                   ;YES ! GO PACK THE DEVICE NAME
       MOVB    (A2)+,(A3)              ;GET FINAL CHARACTER OF DRIVE #
       MOVB    (A2),D1                 ;TEST THE NEXT BYTE ON THE COMMAND LINE
       CMPB    D1,#':                  ;IS IT A COLON?
       JEQ     PCKIT                   ;YES - GO PACK THE DEV AND DRV
                                       ;*ERROR* DEV AND DRV MUST END IN COLON
       SUB     #2,A2
       JMP     CERROR
PCKIT:
       CTRLC   EXIT
       ADD     #1,A2                   ;MOVE TO NEXT BYTE ON COMMAND LINE
       BYP                             ;BYPASS ANY BLANKS
       LIN                             ;END OF LINE?
       JEQ     CERROR                  ;YES ! - *ERROR* ALL INFO ON COMMAND LINE
       NUM                             ;IS THIS CHARACTER NUMERIC?
       JNE     CERROR                  ;*ERROR* - THIS MUST BE A NUMBER!
       CLR     D1                      ;CLEAR OUT ANY JUNK
       GTOCT                           ;GET AN OCTAL NUMBER FROM THE COMMAND LINE
       LEA     A3,BLOCK                ;STORE THAT OCTAL NUMBER IN THE BLOCK
       MOVW    D1,(A3)                 ;  TO BE SEARCHED AREA
GOPCK:
       CTRLC   EXIT
       CLR     D1                      ;CLEAR OUT ANY JUNK
       LEA     A2,ASCBUF               ;A2 MUST POINT TO ASCII CHARACTERS
       LEA     A1,INDEV                ;PACK AND STORE THE DEVICE NAME
       PACK                            ;
       LEA     A2,INDRV                ;GET THE INPUTED DRIVE NUMBER
       GTDEC                           ;MAKE SURE ITS DECIMAL
       LEA     A2,INDRV                ;PUT IT BACK INTO DRIVE # STORAGE
       MOVW    D1,(A2)
       BR      INITDB                  ;

INPBLK:
       CTRLC   EXIT
       CLR     D1                      ;GET THE BLOCK - DSK MUST HAVE BEEN
       GTOCT                           ;DEFAULTED TO GET HERE!
       LEA     A3,BLOCK                ;STORE THE BLOCK NUMBER
       MOVW    D1,(A3)
DEFAUL:
       LEA     A3,INDEV                ;DEVICE DEFAULT AREA
       MOVW    #0,(A3)                 ;MOVE A ZERO FOR DEVICE NAME (FOR IDDB)
       LEA     A3,INDRV                ;MOVE A -1 FOR DRIVE NUMBER (FOR IDDB)
       MOVW    #-1,(A3)

INITDB:                                 ;SET UP AND INIT A DUMMY IDDB
       CTRLC   EXIT
       MOVW    #177400,D1
       TCRT
       CLR     D1
       MOVB    #1,D1
       LSLW    D1,#10
       MOVB    #68.,D1
       TCRT
       TYPE    <Page>
       CLRW    D1
       MOVB    #1,D1
       LSLW    D1,#10
       MOVB    #73.,D1
       TCRT
       LEA     A3,PAGENO
       MOVW    (A3),D1
       DCVT    2,OT$TRM
       MOVW    #177402,D1
       TCRT
       CLR     D1
       LEA     A2,SCRAT                ;LOAD A DUMMY FILESPEC IN
       MOV     A2,D0
       MOVW    #377,(A2)+
       MOVW    #377,(A2)+
       MOVW    #377,(A2)
       MOV     D0,A2
       FSPEC   IDDB(A5)                        ;PROCESS THE FILESPEC (POINTED BY A2)
       LEA     A3,IDDB+D.DEV(A5)       ;PUT THE PROPER DEVICE NAME IN
       LEA     A2,INDEV
       MOVW    (A2),(A3)
       LEA     A3,IDDB+D.DRV(A5)       ;PUT THE PROPER DRIVE NUMBER IN
       LEA     A2,INDRV
       MOVW    (A2),(A3)
       INIT    IDDB(A5)                        ;INITIALIZE THE IDDB
       CTRLC   EXIT
       CLR     D1
       TYPESP  <Block Display of:>
       LEA     A3,IDDB+D.DEV(A5)       ;GET THE IDDB'S DEVICE NAME
       MOVW    (A3),D1                 ;MOVE THE PACKED WORD TO D1
       TST     D1                      ;IS IT A ZERO?
       BNE     UNPCK                   ;NOPE - GO UNPACK THE WORD
       JOBIDX  A3                      ;DEFAULT DEVICE - DETERMINE LOG IN
       LEA     A2,JBDEV                ;   STATUS AND TYPE IT OUT
       CLR     D1
       MOVW    JOBDEV(A3),D1           ;GET THE PACKED DEVICE NAME
       LEA     A1,SCRAT                ;  AND UNPACK IT
       MOVW    D1,(A1)
       LEA     A2,ASCBUF
       UNPACK
       LEA     A2,ASCBUF
       TTYL    (A2)                    ;PRINT THE DEFAULT DEVICE NAME
       CLR     D1
       MOVW    JOBDRV(A3),D1           ;GET THE DEFAULT DRIVE NUMBER
       DCVT    0,OT$TRM                ;CONVERT AND TYPE IT
       TYPE    <:>
       JMP     PUTBLK
UNPCK:
       LEA     A1,INDEV                ;GET AND UNPACK THE DEVICE NAME
       LEA     A2,ASCBUF
       UNPACK
       LEA     A2,ASCBUF
       MOVB    (A2)+,D1                ;PRINT THE DEVICE NAME
       TTY
       MOVB    (A2)+,D1
       TTY
       MOVB    (A2)+,D1
       TTY
       LEA     A2,INDRV                ;GET THE DRIVE NUMBER
       CLR     D1
       MOVB    (A2),D1
       DCVT    0,OT$TRM                ;CONVERT AND TYPE IT
       TYPE    <:>
       CLR     D1

PUTBLK:
       CLR     D1
       LEA     A1,BLOCK                ;GET THE BLOCK NUMBER
       MOVW    (A1),D1
       OCVT    6,OT$TRM                ;CONVERT TO OCTAL AND TYPE IT
       CRLF
       CTRLC   EXIT

GETMFD:
       CLR     D1
       MOV     IDDB+D.DVR(A5),A3       ;GET THE DISK DRIVER ADDRESS
       MOV     24(A3),D2               ;GET THE TOTAL NUMBER OF BLOCKS/DISK
       SUB     #1,D2                   ;SUB 1 - BLOCK ZERO IS FIRST BLOCK
       LEA     A3,BLOCK                ;GET THE INPUTED BLOCK NUMBER
       MOVW    (A3),D1
       CMP     D1,D2                   ;IS THE INPUTED BLOCK LESS THAN BLOCK   [109]
       BLOS    GOMFD                   ;   PER DISK?
BIGERR: TYPECR  <?Block number specified is too large for this device>
       CLR     D1                      ;CLEAR THE OUTPUT REGISTER FOR EXIT
       JMP     EXIT

GOMFD:
       CTRLC   EXIT
       JOBIDX  A3
       MOV     JOBTRM(A3),A0
       ORW     #3,(A0)                 ;SET FORCED IMAGE MODE NO ECHO
       LEA     A1,IDDB+D.REC(A5)       ;LOAD BLOCK AREA IN DDB
       MOV     D1,(A1)
       READ    IDDB(A5)                ;READ THE BLOCK
       CTRLC   EXIT

PBLK:
       CTRLC   EXIT
       MOV     IDDB+D.BUF(A5),A1       ;ADDRESS THE READ BUFFER AREA
       CLR     D1
       MOVB    #3,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT
       MOVW    #177412,D1
       TCRT
       MOV     #0,D0
       MOV     #0,D2
       MOV     D0,D1
PLP:
       MOV     A1,A3                   ;SAVE START OF LINE
       CTRLC   EXIT
       OCVT    3,OT$TRM
       TYPE    <:>
       SPACE   1,ARG2
PLP1:
       CLR     D1
       MOVW    (A1)+,D1
       TSTB    D5
       BNE     HEX1
OCT1:   OCVT    <WDSPC+2>,OT$TRM
       BR      CON1
HEX1:   OCVT    WDSPC,OT$TRM

CON1:   SPACE   1,ARG2
       ADD     #2,D2
       CMP     D2,#16.
       CTRLC   EXIT
       BNE     PLP1
       LEA     A2,BYTTRN
       CLR     D1
       MOVW    #16.,D4
PTRNLP:
       CTRLC   EXIT
       CLRW    D1
       MOVB    (A3)+,D1
       CMPB    D1,#41
       BLT     PUTDOT
       CMPB    D1,#176
       BGT     PUTDOT
       BR      PBYTTR
PUTDOT:
       MOVB    #'.,D1
PBYTTR:
       MOVB    D1,(A2)+
       SUBW    #1,D4
       TST     D4
       BNE     PTRNLP

POUTL:
       CTRLC   EXIT
       CLRW    D1
       LEA     A2,BYTTRN
       TTYL    (A2)
PCRLF:
       CRLF
       CMP     D0,#496.
       JEQ     WDPRT
       CMP     D0,#360
       BNE     PPAGE
       JEQ     WDPRT

PPAGE:
       CTRLC   EXIT
       ADD     D2,D0
       MOV     D0,D1
       CLR     D2
       JMP     PLP


WDPRT:
       CTRLC   EXIT
       CLR     D1
       TSTB    D5
       JNE     HEXHED
OCTHED:
       MOVB    #20.,D1
       LSLW    D1,#10
       MOVB    #6,D1
       TCRT
       TYPECR  < Octal   Decimal    Octal     Decimal     Ascii     RAD 50    Decimal>
       TYPE    <      Word #   Word #   MSB LSB   MSB  LSB   MSB  LSB                Word>
       MOVB    #3,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT
       JMP     CINIT

HEXHED:
       MOVB    #20.,D1
       LSLW    D1,#10
       MOVB    #6,D1
       TCRT
       TYPECR  <  Hex    Decimal     Hex      Decimal     Ascii     RAD 50    Decimal>
       TYPE    <      Word #   Word #   MSB LSB   MSB  LSB   MSB  LSB                Word>
       MOVB    #3,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT

CINIT:
       CTRLC   EXIT
       CLR     D0
       CLR     D1
       CLR     D2
       CLR     D3
       CLR     D4

CPRNT:
       CTRLC   EXIT
       MOV     IDDB+D.BUF(A5),A1
       CLR     D1
       CLR     D2
       CLR     D3
       TSTB    D5
       BNE     CHEX1
COCT1:  MOVW    D0,D3
       MOVB    #3,D1
       LSRW    D0,#10
       ADDB    D0,D1
       LSLW    D1,#10
       MOVW    D3,D0
       MOVB    #<ARG2-2>,D2
       ADDB    #5,D2
       MOVB    D2,D1
       CLRW    D2
       ADDB    D0,D1
       BR      CCON1
CHEX1:  MOVW    D0,D3
       MOVB    #3,D1
       LSRW    D0,#10
       ADDB    D0,D1
       LSLW    D1,#10
       MOVW    D3,D0
       MOVB    #<ARG2-1>,D2
       ADDB    #5,D2
       MOVB    D2,D1
       CLRW    D2
       ADDB    D0,D1
CCON1:  TCRT
       MOV     A1,D2
       MOV     D4,D3
       LEA     A3,PAGENO
       MOVW    (A3),D1
       CMPW    D1,#1
       BEQ     ADOFST
       ADD     #400,D3
ADOFST: ADD     D3,D2
       MOV     D2,A1
       MOVW    #177440,D1
       TCRT
       MOVW    (A1),D1
       TSTB    D5
       BNE     HEX2
OCT2:   OCVT    <WDSPC+2>,OT$TRM
       BR      CON2
HEX2:   OCVT    WDSPC,OT$TRM
CON2:   MOVW    #177441,D1
       TCRT
       CLR     D2
WDTRNS:
       CTRLC   EXIT
       MOVB    #22.,D1
       LSLW    D1,#10
       MOVB    #10,D1
       TCRT
       MOV     D3,D1
       OCVT    3,OT$TRM
       TYPE    <      >
       DCVT    3,OT$TRM
       CLR     D1
       MOVW    (A1),D1
       LEA     A3,LSB
       MOVB    D1,(A3)
       LSRW    D1,#10
       LEA     A3,MSB
       MOVB    D1,(A3)
       TYPE    <     >
       TSTB    D5
       BNE     BHEX2
BOCT2:
       OCVT    <BTRNC+1>,OT$TRM
       BR      BCON2
BHEX2:
       TYPE    < >
       OCVT    BTRNC,OT$TRM
BCON2:
       LEA     A3,LSB
       MOVB    (A3),D1
       TYPESP
       TSTB    D5
       BNE     BHEX3
BOCT3:
       OCVT    <BTRNC+1>,OT$TRM
       BR      BCON3
BHEX3:
       TYPE    < >
       OCVT    BTRNC,OT$TRM
BCON3:
       TYPE    <   >
       LEA     A3,MSB
       MOVB    (A3),D1
       DCVT    3,OT$TRM
       TYPE    <  >
       LEA     A3,LSB
       MOVB    (A3),D1
       DCVT    3,OT$TRM
       TYPE    <    >
       LEA     A3,MSB
       MOVB    (A3),D1
       CMPB    D1,#40
       BGT     UPPCHK
       MOVB    #'.,D1
       BR      TYPASC
UPPCHK:
       CTRLC   EXIT
       CMPB    D1,#176
       BLT     TYPASC
       MOVB    #'.,D1
TYPASC:
       TTY
       TYPE    <    >
       LEA     A3,LSB
       MOVB    (A3),D1
       CMPB    D1,#40
       BGT     UPLCHK
       MOVB    #'.,D1
       BR      TYPASL
UPLCHK:
       CMPB    D1,#176
       BLT     TYPASL
       MOVB    #'.,D1
TYPASL:
       TTY
       TYPE    <     >
UNPKWD:
       MOV     A1,D2                           ;SAVE A1
       LEA     A2,ASCBUF
       UNPACK
       MOVB    #'[,D1
       TTY
       LEA     A2,ASCBUF
       MOVB    (A2)+,D1
       TTY
       MOVB    (A2)+,D1
       TTY
       MOVB    (A2)+,D1
       TTY
       MOVB    #'],D1
       TTY
       MOV     D2,A1
       TYPE    <      >
       MOVW    (A1),D1
       DCVT    5,OT$TRM
       CTRLC   EXIT
QUEST:
       CLR     D1
       CLR     D2
       MOVB    #23.,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT
       MOVW    #177412,D1
       TCRT
       CLRW    D1
       MOVB    #'>,D1
       TTY
       LEA     A2,SCRAT
       CTRLC   EXIT
       KBD
       UCS
       CMPB    D1,#24                  ;IS IT A ^T
       JEQ     NXTPG
       CMPB    D1,#22                  ;IS IT A ^R
       JEQ     PRVPG
       CMPB    D1,#'Q                  ;IS IT A "Q" (QUIT NO UPDATE)
       JEQ     EXIT
       CMPB    D1,#14                  ;IS IT A ->
       JEQ     ADDLSB
       CMPB    D1,#10                  ;<-
       JEQ     SUBLSB
       CMPB    D1,#13                  ;^
       JEQ     SUBMSB
       CMPB    D1,#12                  ;v
       JEQ     ADDMSB
       CMPB    D1,#'L                  ;IS IT A "L" (LONG WORD DISPLAY)
       JEQ     LWDDSP
       CTRLC   EXIT
       JMP     QUEST


LWDDSP:
       CTRLC   EXIT
       MOV     IDDB+D.BUF(A5),D2
       MOV     D4,D3
       LEA     A3,PAGENO
       MOVW    (A3),D1
       CMPW    D1,#1
       BEQ     ADOFLW
       ADD     #400,D3
ADOFLW: ADD     D3,D2
       MOV     D2,A1
       MOVB    #24.,D1
       LSLW    D1,#10
       MOVB    #5,D1
       TCRT
       CMP     D3,#510.
       BEQ     BNDERR
       TSTB    D5
       BNE     TYPHXL
TYPOCL:
       TYPESP  <Octal Longword>
       BR      TYPCN1
TYPHXL:
       TYPESP  < Hex  Longword>
TYPCN1: MOV     (A1),D1
       OCVT    11.,OT$TRM
       TYPE    <                >
       TYPESP  <Decimal Longword>
       DCVT    11.,OT$TRM
       CLR     D1
       BR      TCMD
BNDERR:
       TYPE    <Longword boundry violation>
TCMD:   MOVB    #23.,D1
       LSLW    D1,#10
       MOVB    #3,D1
       TCRT
       MOVW    #177440,D1
       TCRT
       TYPESP  < Any key to continue>
       MOVW    #177441,D1
       TCRT
       CTRLC   EXIT
       KBD
       CTRLC   EXIT
       CLR     D2
       JMP     CPRNT

ADDLSB:
       CTRLC   EXIT
       CALL    NORPT
       TSTB    D5
       BNE     HPTHA
OPTHA:  CMPB    D0,#49.
       BNE     COLOKA
       BR      CPTHA
HPTHA:
       CMPB    D0,#42.
       BNE     COLOKA
CPTHA:  MOVB    #0,D0
       SUB     #14.,D4
       JMP     CPRNT
COLOKA:
       TSTB    D5
       BNE     ALHEX1
ALOCT1:
       ADDB    #7,D0
       BR      ALCON1
ALHEX1:
       ADDB    #6,D0

ALCON1: ADD     #2,D4
       JMP     CPRNT

SUBLSB:
       CTRLC   EXIT
       CALL    NORPT
       CMPB    D0,#0
       BNE     COLOKS
       TSTB    D5
       BNE     HPTHS
OPTHS:
       MOVB    #49.,D0
       ADD     #14.,D4
       JMP     CPRNT
HPTHS:
       MOVB    #42.,D0
       ADD     #14.,D4
       JMP     CPRNT
COLOKS:
       TSTB    D5
       BNE     SLHEX1
SLOCT1:
       SUBB    #7,D0
       BR      SLCON1
SLHEX1:
       SUBB    #6,D0

SLCON1: SUB     #2,D4
       JMP     CPRNT

ADDMSB:
       CTRLC   EXIT
       CALL    NORPT
       CLR     D2
       MOVW    D0,D2
       LSRW    D0,#10
       CMPB    D0,#15.
       BNE     ROWOKA
       MOVB    #0,D0
       SUB     #240.,D4
       LSLW    D0,#10
       MOVB    D2,D0
       JMP     CPRNT
ROWOKA:
       ADDB    #1,D0
       LSLW    D0,#10
       MOVB    D2,D0
       ADD     #20,D4
       JMP     CPRNT

SUBMSB:
       CTRLC   EXIT
       CALL    NORPT
       CLR     D2
       MOVW    D0,D2
       LSRW    D0,#10
       CMPB    D0,#0
       BNE     ROWOKS
       MOVB    #15.,D0
       ADD     #240.,D4
       LSLW    D0,#10
       MOVB    D2,D0
       JMP     CPRNT
ROWOKS:
       SUBB    #1,D0
       LSLW    D0,#10
       MOVB    D2,D0
       SUB     #20,D4
       JMP     CPRNT

NORPT:
       CTRLC   EXIT
       MOV     IDDB+D.BUF(A5),A1
       CLR     D1
       CLR     D2
       CLR     D3
       TSTB    D5
       BNE     NHEX1
NOCT1:  MOVW    D0,D3
       MOVB    #3,D1
       LSRW    D0,#10
       ADDB    D0,D1
       LSLW    D1,#10
       MOVW    D3,D0
       MOVB    #<ARG2-2>,D2
       ADDB    #5,D2
       MOVB    D2,D1
       CLRW    D2
       ADDB    D0,D1
       BR      NCON1
NHEX1:  MOVW    D0,D3
       MOVB    #3,D1
       LSRW    D0,#10
       ADDB    D0,D1
       LSLW    D1,#10
       MOVW    D3,D0
       MOVB    #<ARG2-1>,D2
       ADDB    #5,D2
       MOVB    D2,D1
       CLRW    D2
       ADDB    D0,D1
NCON1:  TCRT
       MOV     A1,D2
       MOV     D4,D3
       LEA     A3,PAGENO
       MOVW    (A3),D1
       CMPW    D1,#1
       BEQ     ADOFNP
       ADD     #400,D3
ADOFNP: ADD     D3,D2
       MOV     D2,A1
       MOVW    #177441,D1
       TCRT
       MOVW    (A1),D1

       TSTB    D5
       BNE     HEX3
OCT3:   OCVT    <WDSPC+2>,OT$TRM
       BR      CON3
HEX3:   OCVT    WDSPC,OT$TRM
CON3:   MOVW    #177441,D1
       TCRT
       CLR     D2
       RTN

PRVPG:
       CTRLC   EXIT
       CLR     D1
       LEA     A3,PAGENO
       MOVW    (A3),D1
       CMPW    D1,#1
       JEQ     QUEST
       SUBW    #1,(A3)
       CTRLC   EXIT
       CLR     D1
       MOVB    #1,D1
       LSLW    D1,#10
       MOVB    #73.,D1
       TCRT
       TYPESP  < >
       TCRT                            ;D1 ALREADY HAS THE POSIT
       CLR     D1
       MOVW    (A3),D1
       DCVT    2,OT$TRM
       CLRW    D1
       MOVB    #3,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT
       MOVW    #177412,D1
       TCRT
       CLRW    D1
PRVDO:
       CTRLC   EXIT
       CLR     D2
       CLR     D0
       CLR     D1
       MOV     IDDB+D.BUF(A5),A1
       JMP     PLP

NXTPG:
       CLR     D1
       LEA     A3,PAGENO
       MOVW    (A3),D1
       CMPW    D1,#2
       JEQ     QUEST
       CTRLC   EXIT
       ADDW    #1,(A3)
       MOVB    #1,D1
       LSLW    D1,#10
       MOVB    #73.,D1
       TCRT
       TYPESP  < >
       TCRT                            ;D1 ALREADY HAS THE POSIT
       CLR     D1
       MOVW    (A3),D1
       DCVT    2,OT$TRM
       CLRW    D1
       MOVB    #3,D1
       LSLW    D1,#10
       MOVB    #1,D1
       TCRT
       MOVW    #177412,D1
       T
CRT
       CLRW    D1
NEXDO:
       CTRLC   EXIT
       CLR     D2
       MOV     #400,D0
       MOV     IDDB+D.BUF(A5),D1
       ADD     #400,D1
       MOV     D1,A1
       MOV     D0,D1
       JMP     PLP


BLOCK:  BLKB    2                       ;STORAGE FOR THE INPUT BLOCK NUMBER
SCRAT:  BLKB    6                       ;SCRATCH AREA
JBDEV:  BLKB    2                       ;JOB DEVICE STORAGE
JBDRV:  BLKB    2                       ;JOB DRIVE STORAGE
PACBUF: BLKB    2
ASCBUF: BLKB    4                       ;ASCII BUFFER
INDEV:  BLKB    6
INDRV:  BLKB    2
PAGENO: BLKB    2                       ;PAGE NUMBER
BYTTRN: BLKB    17.                     ;ASCII BYTE INTERPRETATION
MSB:    BLKB    1
LSB:    BLKB    1
DSPFLG: BLKB    1


EVEN

CERROR:
       CLR     D1
       MOV     A2,D1
       SUB     D2,D1
       MOV     D1,D2
       ADD     #10,D2
       CLR     D1
ELOOP:
       TST     D2
       BEQ     PERROR
       MOVB    #40,D1
       TTY
       SUB     #1,D2
       BR      ELOOP


PERROR:
       CLR     D1
       MOVB    #'^,D1
       TTY
       TYPECR  <Specification error>
       CLRW    D1
EXIT:
       TTY                             ;CARRY FROM Q
       CRLF
       MOVW    #177434,D1              ;CURSOR ON
       TCRT
       EXIT
END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.