 
*  CHARREAD/S                 Dec / 15 / 92
 
 
*  Must be used in Funnelweb environment
 
       AORG >A050             Sit above FW mailbox
 
 
PABV   EQU  >D80
PBFV   EQU  >0E00
PBFOUT EQU  >1700
 
 
DSRLNK EQU  >FFD4
KSCANA EQU  >FFD0
FILENT EQU  >FFCC
VMBWD  EQU  >FFBA
VMBRD  EQU  >FFB6
RDDEV  EQU  >FFA0
LDR11  EQU  >FF9C
FWREG  EQU  >FF7C
ESFLAG EQU  >FF60
CMSRET EQU  >FF5C
QDXFL  EQU  >FF52
QDLOAD EQU  >FF3C
AIDFL  EQU  >FF3A
QDSAV  EQU  >FF20
VMBW   EQU  >FED4
VMBR   EQU  >FED0
VSBW   EQU  >FECC
VSBR   EQU  >FEC8
HXTAB  EQU  >FEA4
 
QDPOS  EQU  >CE00
QDLEN  EQU  >A40
 
 
       REF  VDPWD
 
       DEF  SFIRST,SLAST
 
 
SFIRST EQU  $
       LIMI 0
       C    R11,@LDR11
       JEQ  ISFW
       BLWP @>0
ISFW   LWPI FWREG
       MOV  @QDSAV,@QDXFL
       JNE  SAVE30
 
       MOV  @QDLOAD,R11
       BL   *R11
       DATA 'QD',QDPOS,QDLEN
       JMP  SAVE30
       SETO @QDXFL
SAVE30 LI   R11,AIDQD
       MOV  R11,@AIDFL
 
*  Clear screen
 
RESTT  LWPI FWREG
       LI   R11,EXITEM
       MOV  R11,@ESFLAG
 
*  Clear screen
 
       CLR  R0
       LI   R1,>2001
ONE    EQU  $-1
       LI   R2,>300-1
       BLWP @VSBW
CLRS1  MOVB R1,@VDPWD
       DEC  R2
       JNE  CLRS1
 
*  Write up page header and initial message
 
       BLWP *R9
       DATA >C08,ULDAT,8
       BLWP *R9
       DATA 3
       DATA SLMS10,SLML10
       LI   R0,>8181
       BLWP *R8
       DATA >23,SLML10
 
*  Input file selection
 
       BLWP *R9
       DATA >82
       DATA IPMSG,IPMSL
       BLWP *R8
       DATA >A2,IPMSL
       BLWP *R9
       DATA >E2
       DATA INPNAM,15
       BLWP @FILENT
       DATA >E2,25
       MOV  @RDDEV,R11
       BL   *R11
       DATA >E2,PABNAM
       DATA PABV,PABDAT
 
*  Clear initial message and CHAR data  buffer
 
       CLR  R0
       BLWP *R8
       DATA PBFV,>0900
       BL   @FILOP
       JMP  ERROR
 
*  Choose option
 
       LI   R11,RESTT
       MOV  R11,@ESFLAG
       LI   R0,>8100
       BLWP *R8
       DATA >242,SLML20
       BLWP *R9
       DATA >282
       DATA SLMS20,SLML20
       BLWP *R9
       DATA >2C2
       DATA SLMS21,SLML21
       LI   R0,>2020
CHOPTN BLWP @FILENT
       DATA >282,1
       CB   @>8322,@AONE
       JEQ  MAKOUT
       CB   @>8322,@ATWO
       JNE  CHOPTN
       B    @SHORTR
 
 
*  Open output file
 
MAKOUT BLWP *R8
       DATA >240,>C0
       BLWP *R9
       DATA >142
       DATA OPMSG,OPMSL
       LI   R0,>8181
       BLWP *R8
       DATA >162,OPMSL
       BLWP *R9
       DATA >1A2
       DATA FLNAME,15
 
       BLWP @FILENT
       DATA >1A2,25
       MOV  @RDDEV,R11
       BL   *R11
       DATA >1A2,PBONAM
       DATA PABV,PBODAT
       BL   @FILOP
       JMP  ERROR
 
*  Process data
 
       SETO R4
SNDOUT INC  R4
       CI   R4,255
       JHE  CLOSIN
 
       MOV  R4,R0
       SLA  R0,3
       AI   R0,PBFV
       LI   R1,CBUF
       LI   R2,8
       BLWP @VMBR
       MOV  R4,R0
       LI   R3,OUTID
       BL   @HEXBYU
       LI   R3,OUTPAT+1
SND20  MOVB *R1+,R0
       BL   @HEXBYT
       MOVB *R1+,R0
       BL   @HEXBYT
       INCT R3
       DECT R2
       JGT  SND20
 
*  Write out records
 
       MOVB @WRITE,@PBODAT
       BLWP *R9
       DATA PBFOUT
       DATA OUTREC,PBRCLN
       MOV  @RDDEV,R11
       BL   *R11
       DATA >1A2,PBONAM
       DATA PABV,PBODAT
       BL   @FILOP
       JMP  ERROR
       JMP  SNDOUT
 
*   Close output file
 
CLOSIN MOVB @CLOSE,@PBODAT
       MOV  @RDDEV,R11
       BL   *R11
       DATA >1A2,PBONAM
       DATA PABV,PBODAT
       BL   @FILOP
       NOP
       JMP  EXITEM
 
*  Error exit
 
ERROR  LI   R0,>2E7
       LI   R1,ERMS1
       LI   R2,ERMS1L
       BLWP @VMBW
       BLWP @KSCANA
       JEQ  $-4
       JMP  KEY
 
*  Exit
 
EXITEM LWPI FWREG
       LI   R0,>2E7
       LI   R1,KEYMS
       LI   R2,KEYML
       BLWP @VMBW
KEY    BLWP @KSCANA
       JOP  KEY
 
       CLR  R13
       CLR  @ESFLAG
       CLR  @AIDFL
       MOV  @CMSRET,R11
       RT
 
*  AID key response
 
AIDQD  EQU  $
       MOV  @QDXFL,R0
       JEQ  ADQ30
 
       BL   @QDPOS
ADQ30  RTWP
 
 
*  Shorten CHAR file to min whole sectors
 
SHORTR BLWP *R8
       DATA >240,>C0
       BLWP @VMBRD
       DATA PBFV,CHBUF,>800
       LI   R1,>800
 
SHRT10 DECT R1
       JEQ  ERROR
 
       MOV  @CHBUF(R1),R0
       JEQ  SHRT10
 
       AI   R1,>FE
       ANDI R1,>0F00
 
       MOV  R1,@SAVLEN
       MOVB @SAVEOP,@PABDAT
 
*  Output file selection
 
       BLWP *R9
       DATA >142
       DATA OPMSG,OPMSL
       LI   R0,>8100
       BLWP *R8
       DATA >162,OPMSL
       BLWP *R9
       DATA >1A2
       DATA INPNAM,15
       BLWP @FILENT
       DATA >1A2,25
       MOV  @RDDEV,R11
       BL   *R11
       DATA >1A2,PABNAM
       DATA PABV,PABDAT
       BL   @FILOP
       JEQ  ERROR
       JMP  EXITEM
 
 
*  Form Hex byte
 
HEXBYT EQU  $
       SRL  R0,8
HEXBYU MOV  R0,R6
       MOV  R0,R14
       ANDI R6,>000F
       ANDI R14,>00F0
       SRL  R14,4
       MOVB @HXTAB(R14),*R3+
       MOVB @HXTAB(R6),*R3+
       RT
 
 
*  HELPED  to disk
*-----------------
 
FILOP  EQU  $
       LI   R3,PABV+9
       MOV  R3,@>8356
       BLWP @DSRLNK
       JEQ  EXERR
       LI   R0,PABV+1
       BLWP @VSBR
       SRL  R1,13
       JNE  EXERR
       INCT R11
EXERR  RT
 
*  Underline data
 
ULDAT  DATA >0000,>00FF,>0,>0
 
 
*  Input PAB data
 
PABDAT DATA >0500,PBFV-6,>0
SAVLEN DATA >0900
       BYTE >00
PABNAM BYTE >0B
INPNAM TEXT 'DSK'
       TEXT '5.CHARA1          '
PABLEN EQU  $-PABDAT
 
 
PBODAT DATA >0012
       DATA PBFOUT
       BYTE >50
       BYTE PBRCLN
       DATA >0
       BYTE >0
PBONAM BYTE >0E
FLNAME TEXT 'DSK5.CHARDAT/S            '
PBOLEN EQU  $-PBODAT
       EVEN
 
CBUF   BSS  8
 
 
OUTREC TEXT 'CHAR'
OUTID  TEXT '00 DATA '
OUTPAT TEXT '>0000,>0000,>0000,>0000'
PBRCLN EQU  $-OUTREC
 
 
 
IPMSG  TEXT 'Input from :'
IPMSL  EQU  $-IPMSG
 
OPMSG  TEXT 'Output to  :'
OPMSL  EQU  $-OPMSG
 
SLMS10 TEXT 'FWb Character File Reader'
SLML10 EQU  $-SLMS10
 
SLMS20 TEXT '1   1  Save as Source File'
SLML20 EQU  $-SLMS20
 
SLMS21 TEXT '    2  Re-Save at min size'
SLML21 EQU  $-SLMS21
 
 
KEYMS  TEXT ' ** Key to exit **'
KEYML  EQU  $-KEYMS
 
ERMS1  TEXT 'Disk/File problem '
ERMS1L EQU  $-ERMS1
 
CLOSE  BYTE >01
WRITE  BYTE >03
SAVEOP BYTE >06
AONE   BYTE '1'
ATWO   BYTE '2'
 
       EVEN
SLAST  EQU  $
CHBUF  BSS  >800
 
       END
 
