 
*  ED2/LSMOD                  Apr / 01 / 95
 
*  Twdslk, Dsrdir
*  Load, Save, Print, LdTemp, Open, Close, IO, IORec
*  Parse, Vinit, C2V
*  Purge, SD, LnDisp
*  Inifla, Trecrd, Precrd, Conwtb
 
*  TWDSLK - >8 / >A following data - modify offset on fly
*--------------------------------------------------------
*  DSRDIR - direct re-entry without search
*         - use only within open/close of a file
 
TWDSLK DATA DSRWS,LNKDSR      Full DSRlink
DSRDIR DATA DSRWS,LNKDIR      Direct re-entry DSRlink
 
*  Data stored at OPEN
*---------------------------
*  Use only on same L/S call
 
DSRDAT EQU  $
SAVVER DATA 0
SAVCRU DATA 0
SAVENT DATA 0
SAVSCN DATA 0
SAVNPT DATA 0
 
*  Full DSRLNK code
*------------------
 
LNKDSR EQU  $
       MOV  *R14+,@DSRTYP     Set access type
       LWPI GPLWS             Use GPL workspace
       LI   R1,SCNAME         Byte saver
       MOV  *R1,R9            Get name length pointer
       BL   @SETRDA           Set VDP read at device name in PAB
       MOVB @VDPRD,R7         Save total length & advance
       SRL  R7,8              As a word
       SETO R6                Initialize counter
       LI   R2,FAC            Use FAC as buffer
LNK$LP INC  R6                Next byte and count in R6
       C    R6,R7             Last character ?
       JEQ  LNK$LN            Yes, escape loop
       MOVB @VDPRD,*R2        Copy name to buffer
       CB   *R2+,@PERIOD      Is it the separator ?
       JNE  LNK$LP            Not yet
 
*  Name found to first delimiter
 
LNK$LN MOV  R6,R6             How long was it ?
       JEQ  LNKERR            Null must be error
       CI   R6,8              Name too long ?
       JGT  LNKERR            Yes
       INC  *R1               Advance to next part of name
       A    R6,*R1            After first part in SCNAME
       MOV  R6,@SCLEN         Set device name length
 
*  Search for DSR - multiple RS232 included
 
       CLR  R1                Initialize multiple card search
       LI   R12,>0F00         Initialize DSR search
CRUSTT EQU  $-2
NOROM  SBZ  0                 Current ROM off
       CLR  @CRULST
       AI   R12,>0100         Next ROM
CRUINC EQU  $-2
CRUEND EQU  $+2
       CI   R12,>2000         All done ?
       JEQ  NODSR             Not found then
       MOV  R12,@CRULST       Save CRU base
       SBO  0                 ROM on
       LI   R2,>4000          DSR ROM address
       CB   *R2,@HAA          Ident byte of DSR
       JNE  NOROM             Not a valid DSR header
       AI   R2,8              Pointer for DSR name chain
DSRTYP EQU  $-2               Write in value at entry
       JMP  SGO2              Go compare device name
 
*  Do not use R6 in SGO loop - multiple RS232
 
SGO    MOV  @STADDR,R2        Looking for name
       SBO  0                 Reset DSR on for error path  ?????
 
*  Look for device name in this DSR ROM
 
SGO2   MOV  *R2,R2            Last name in this ROM ?
       JEQ  NOROM             Try next then
       MOV  R2,@STADDR        Save pointer ro next name
       INCT R2                Advance to entry pointer
       MOV  *R2+,R9           Save it & advance to length byte
       MOV  @SCLEN,R5         Fetch device name length as word
       CB   @SCLEN+1,*R2+     Check length in DSR - LSB only needed
       JNE  SGO               Bail out now
       LI   R3,FAC            Device name buffer
NAME1  CB   *R3+,*R2+         Check against name in buffer
       JNE  SGO               Not the one
       DEC  R5                Count down
       JNE  NAME1             More to do
 
*  Save DSR entry values
 
       INC  R1                Next RS232 card if re-entered
       LI   R11,DSRDAT        Point to data list
       MOV  R1,*R11+          SAVVER
       MOV  R12,*R11+         SAVCRU
       MOV  R9,*R11+          SAVENT
       MOV  @SCNAME,*R11+     SAVSCN
       MOV  @SCLEN,*R11       SAVNPT
 
*  Execute DSR
 
EXEDSR BL   *R9               Execute DSR
       JMP  SGO               Special error return for 2 x RS232
       SBZ  0                 ROM off
 
*  Good exit
 
       LWPI DSRWS             Normal return
       SZCB R12,R15           Clear error indicator
       RTWP
 
*  Error exit
 
LNKERR EQU  $
NODSR  LWPI DSRWS             Restore workspace
       SOCB R12,R15           Flag error
       RTWP
 
*  Data and WSp
 
DSRWS  EQU  $-24
       BYTE >20               EQU bit mask as R12 MSByte
HAA    BYTE >AA               In R12  LSByte
       DATA >0,>0,>0          R13 - R15
 
*  DSR direct entry for record R/W
*---------------------------------
 
LNKDIR EQU  $
       INCT R14               Match full entry - ignore data item
       LWPI GPLWS             As for internals of DSRLNK
 
*  Restore values at DSR entry
 
       LI   R11,DSRDAT        Data block
       MOV  *R11+,R1          SAVVER
       MOV  *R11+,R12         SAVCRU
       MOV  *R11+,R9          SAVENT
       MOV  *R11+,@SCNAME     SAVSCN
       MOV  *R11,@SCLEN       SAVNPT
       SBO  0                 Turn on DSR ROM
       JMP  EXEDSR            Execute DSR
 
*  LOAD/SAVE PAB data and defaults
*---------------------------------
*  Note word alignment
 
PABOC  BYTE 0                 Op code
PABST  BYTE 0                 Status
PABBAD DATA PABBUF            Buffer address
PABLRL BYTE 80                Logical recode length
PABCCT BYTE 80                Character count
PABRN  DATA 0                 Record number
PABSO  BYTE 0                 Screen offset
PABNL  BYTE 0                 Name length
SLRL   DATA >5050             Default logical record length
MLRL   DATA >8080             For DF/128
PBFNOM DATA PABBUF            Usual buffer position data
THREE  EQU  $
WRITE  BYTE 3                 DSR Opcode
MASK80 EQU  MLRL              Be economical
BFC    BYTE >FC               Euro tab record
CTRLZ  BYTE >1A               MSDOS terminator
PCCENT BYTE 0                 Prt control flag for entry
PCCEXT BYTE 0                 Exit
 
*  Recognized flag chars
 
CHTAB  EQU  $
C      BYTE 'C'               |
LL     BYTE 'L'               |  Order to
F      BYTE 'F'               |
M      BYTE 'M'               |  match flags
U      BYTE 'U'               |
P      BYTE 'P'               |
Q      BYTE 'Q'               |
A      BYTE 'A'               |
CHTBL  EQU  $-CHTAB
       EVEN
 
*  Keep order of these flags
 
STARTL DATA 0                 |
STOP   DATA 0                 |
LREAD  DATA 0                 |
PFLAG  DATA 0                 | For saving line counts
 
*  User set flags
 
UFTAB  EQU  $
CFLAG  DATA 0       Clean     |
LFLAG  DATA 0       Lines     |
FFLAG  DATA 0       D/F       | Retain block order
MSFLAG DATA 0       MSDos     |
UXFLAG DATA 0       Unix      |
PCFLAG DATA 0       PrtCodes  |
QCFLAG DATA 0       Excodes   |
APFLAG DATA 0       Append DV |
UFTBN  EQU  $
 
*  SD overlay block for temp use at start
*  Current overwritten block size is >1D0
 
SDLMEM EQU  $
 
*----------------------------------------
*  LOAD entry from Command line processor
*----------------------------------------
*  Loads with line # come to temp
 
LDTP01 EQU  $
       BL   @SAVFIL           Save new temp name
       DATA FTLNAM            Temp file name
       CLR  R15               Flag transient name
       JMP  LOADT1            To common code
 
LOAD01 EQU  $
       BL   @SAVFIL           Save new file-name
       DATA FILNAM            Back in mailbox
       SETO R15               Flag for registering name
LOADT1 SETO @PFLAG            No tab read unless CLR by purge
       BL   @PARSLD           CNT = line number, String -> name
       CLR  @LINENO           Merge line number.(from source)
       LI   R0,STARTL         Byte saver
       CLR  *R0+              Start line number (from destination)
       SETO *R0               Stop line number (from destination)
       DEC  *R0               @STOP
       DECT R0                Back to STARTL
 
*  Open file as Dis/Var or Fix 80
*--------------------------------
 
       BL   @OPEN             Check file pathname before purge
       DATA >0014             Open it as DV
       JMP  LOADDF            Not found
       JMP  LOAD10            Successful - proceed
 
LOADDF BL   @OPEN             Try again as D/F
       DATA >0004             Open data for DF
       JMP  ERRJM1            Bail out on error this time
 
*  Distinguish Loading modes
*--------------------------------------
*  Assume NUM1-3,NUMCHK stored in order
 
LOAD10 BL   @RCDNAM           Record name for box
       LI   R11,NUM1          Byte saver
       MOV  *R11,*R11         Any line numbers entered?
       JLT  LDPURG            No, purge and use defaults.
       INC  *R11+             NUM1
       MOV  R11,R15           Save pointer at NUM2
       INC  *R11+             NUM2
       INC  *R11+             NUM3
       MOV  *R11,*R11         NUMCHK - how many numbers entered?
       JGT  LD1NUM            One - load and insert
       JLT  LD3NUM            Three - load piece and insert
LD2NUM DECT R15               Two - load part of external file
LD3NUM MOV  *R15+,*R0+        NUM1or2 -> STARTL
       MOV  *R15,*R0          NUM2or3 -> STOPL - load all of file.
       C    @-2(R15),*R15     NUM1or2 <> NUM2or3
       JH   ERRJM1            Can't do that
       DECT R0                Back to STARTL
       CI   R15,NUM3          Was it 3 number entry ?
       JEQ  LD1NUM            No - do not purge buffer
LDPURG BL   @PURGE            Purge buffer
       BLWP @INISEG
       JMP  LDEXTL            Go load it
 
*  Merge external file after line #
 
LD1NUM LI   R11,LINENO        Byte saver
       MOV  @NUM1,*R11        File merge
       MOV  @SAVER0,R15       Line number 0?
       JNE  LOAD05            No
       DEC  *R11              Yes - back up LINENO by 1
LOAD05 C    *R11,@EOF         Past end of file ?
       JLE  LDEXTL            No - OK
       MOV  @EOF,*R11         Replace by EoF then
 
*  Set up LOAD from external source
 
LDEXTL EQU  $
       S    *R0+,*R0          STARTL > STOPL known
       INC  *R0+              STOPL
       CLR  *R0               LREAD -> #lines read from file.
 
*  Load file records
 
LOAD20 BL   @IORCRD           Go read a record - clear first
       JMP  ERRJM1            Load error, code in R9
       BL   @MOVE             Move buffer to CPU
       DATA PABBUF            Standard buffer
       DATA LINBUF,80
 
*  Check MSB for -->> TAB record
 
       LI   R15,LINBUF        Point to CPU buffer
       MOV  R15,@BUFADR       Use LINBUF as source buffer
       CLR  R10               Flag for if USA tab
       CB   *R15,@MASK80      Check leading byte
       JEQ  CHKTAB            USA tab record possible
       SETO R10               Flag for if Euro tab
       CB   *R15,@BFC         Eurowriter TABs ?
       JNE  LOAD25            No
 
*  Copy to temp and check for Tab record
 
CHKTAB C    @LLL-2(R15),@DSPACE  Check last 2 bytes
       JNE  LOAD25              Not a Tab record
       S    R10,R15           E/W offset by 1  (SETO)
       LI   R9,SQSBUF+6       Use this as temp
       MOV  R9,R14            Copy for later use
TBRC10 MOVB *R15+,*R9         Transfer byte
       SZCB @MASK80,*R9+      Remove high bit anyway
       CI   R9,SQSBUF+6+LLL-2 Done - 78 bytes transferred
       JL   TBRC10
 
*  Search for record length and check for 22, 44, 66
 
TBRC20 C    @-2(R9),@DSPACE   Blanks ?
       JNE  TBRC30            No - stop search at INDENT
       DECT R9                Previous word
       C    R9,R14            Back at start ?
       JH   TBRC20            Line not all blanks here
       JMP  TABNOT            This should never happen !
ERRJM1 JMP  ERROR             Intermediate JMP for OofR
 
TBRC30 CLR  R8                Clear MSW of dividend
       S    R14,R9            Count as LSW
       MOV  R9,@-2(R14)       Save length
       DIV  @D22,R8           Is it a multiple of 22 ?
       MOV  R9,R9             Check remainder
       JNE  TABNOT            Yes - not legit
 
*  Check line details
 
TBRC40 DEC  R8                R8 has count
       JOC  TBRC60
       MOV  R14,R11           Copy starter
       AI   R11,20            Point to INDENT in this block
       LI   R12,6             Low limit
       LI   R13,85            High limit
       C    *R14,R12          LMRG low ?
       JL   TABNOT
       C    *R14+,R13         LMRG high ?
       JH   TABNOT
       C    *R14,R12          RMRG low ?
       JL   TABNOT
       C    *R14+,R13         RMRG high ?
       JH   TABNOT
       C    *R11,R12          INDENT low ?
       JL   TABNOT
       C    *R11,R13          INDENT high ?
       JH   TABNOT
       SWPB R12               Byte values now  6
       SWPB R13                           and  85
TBRC50 CB   *R14,R12          Tab entry byte
       JL   TABNOT            Too low
       CB   *R14+,R13
       JH   TABNOT            Too high
       C    R14,R11           16 worth
       JL   TBRC50            Not yet
       INCT R14               Over INDENT to next block
       JMP  TBRC40            Check if more
 
*  Assume a tab record now & write tab data 1-3
 
TBRC60 ABS  @PFLAG            Has it been purged ?
TABINC JNE  LOAD20            Ignore tab record  (no purge)
       BL   @VSTRU            Write as string to VDP
       DATA SQSBUF+5          Length in LSB (22,44, or 66)
       DATA TABBUV            Buffer for tab data
       BL   @MOVE             Write to format table
       DATA TABBUV            VDP storage
       DATA FORMO,22          Work with first block
       LI   R8,REPBM6         Use replace buffer
       LI   R9,MMTPT          Tabline data index
       BL   @MVISTR           Fetch as indexed string
       LI   R9,REPBM6+>56     Tabline image position
       BL   @GENTAC           Write out tab details in footer line
LOAD21 JMP  LOAD20            Tabs taken care of now
 
TABNOT EQU  $                 Direct exit - tabs taken care of
LOAD25 LI   R11,LREAD         Byte saver
       INC  *R11              Count one read
       C    *R11,@STARTL      Time to insert line yet ?
       JLT  LOAD20            No, just forget it
       BLWP @INSTLN           Insert line
       DEC  @STOP             All read in ?
       JNE  LOAD30            Not yet
 
*  All read in now
 
LOADCL BL   @CLOSE            Close the file
       JMP  ERR02             Failure
       JMP  ERR02             Success - all the same
 
*  Check if INSTLN worked
 
LOAD30 MOV  R0,R9             Error flag
       JNE  ERROR             No problems
       MOV  *R11,R9           Current LREAD line read
       S    @STARTL,R9        Make actual read in
       BL   @LNDISP           Display on command line
       JMP  LOAD21            No problems
 
*  Error handlers
 
ERROR  LI   R12,4             For number conversion - 2 digits
       CI   R9,5              End of file error ?
       JNE  ERR05             No - more serious
ERR02  CLR  @CRFLAG           Exit on EoF
       SETO @PURGED           No longer purged state
       MOV  @EDWIDN,R9
       BLWP @REPEDW
       B    @CMDXIT           Command mode exit
 
*  IO error message setup
*------------------------
 
ERR05  LI   R10,IORNM         Convert error code to ASCII
       BL   @NXDIG            2 digit decimal
       LI   R10,IOERP         Point to IOER message
       MOV  R10,@ERFLAG       Write as flag
       BL   @CLOSE            Close file just in case
       NOP                    IGNORE failure
       SETO @CHNGED           In case of failure
ERR10  B    @ERRM10           Main program error handler
 
*---------------------------------
*  Print file with option decode
*---------------------------------
 
PF01   EQU  $
       SETO @PFLAG            Ban Tab record for PrintFile
       BL   @INIFLA           Clear flag block
       LI   R8,CTEXT          Command line start -->> CMLCHK
PF10   BL   @CMLH10           Skip leading blanks
       JMP  ERR02             End of line & nothing to show
       JMP  PF20              Not a number - check as flag
       JMP  PF70              Numeric - parse as line #
 
*  Check for isolated command flag
 
PF20   CB   @1(R8),@DSPACE    Valid separator?
       JEQ  PF30              Yes
       CB   @1(R8),@COMMA     The other one
       JNE  PF70              No
 
*  Check for command flags
 
PF30   CLR  R6                Initialize flag search index
PF40   CB   *R8,@CHTAB(R6)    Check single character
       JEQ  PF60              Match found
       INC  R6                Advance pointer to next table entry
       CI   R6,CHTBL          All done ?
       JL   PF40              Not yet
PF50   INC  R8                Push along command line
       JMP  PF10              Restart search and ignore unrecognized
 
PF60   A    R6,R6             Make word index
       SETO @UFTAB(R6)        Set flag
       JMP  PF50              Now look for next
 
PF70   BL   @PARSLE           Parse rest of line.
       JMP  SAVE04            Join Save code
 
*------------------------------
*  SAVE file to external device
*------------------------------
 
SDTP01 EQU  $
       BL   @SAVFIL           Save temp filename back
       DATA FTLNAM            VDP storage
       CLR  R15
       JMP  SAVET1            To common code
 
SAVE01 EQU  $
       BL   @SAVFIL           Note filename
       DATA FILNAM
       SETO R15
SAVET1 CLR  @PFLAG            Allow tab record for Save
       BL   @INIFLA           Initialize flag array - none here
       BL   @PARSLD           String -> filename, COLSTA = first line
 
*  Check line #s
 
SAVE04 CLR  R9                Show line error as 00
       LI   R11,NUM1          Byte saver
       MOV  *R11,R8           Check user entry of first line
       JLT  SAV10             Still initialized - no #s
       ABS  @NUMCHK           Either 2 or no numbers entered
       JNE  ERROR             Error - 1 or 3 #s
       C    R8,@2(R11)        First line > last line?
       JH   ERROR             No can do
       JMP  SAVE20            Continue then
 
*  Set line #s when none specified
 
SAV10  CLR  *R11+             Set up for whole file NUM1
       MOV  @EOF,*R11         To the bitter end     NUM2
       CLR  @CHNGED           For whole file save
 
*  Open the file for write
*-------------------------
 
SAVE20 EQU  $
       ABS  @MSFLAG           MSdos DF/128 output ?
       JNE  OPB128
       ABS  @UXFLAG           Unix compatible ?
       JNE  OPA128
       ABS  @FFLAG            Fixed 80 flag set?
       JNE  OPENDF            Yes - use record length aet
       ABS  @APFLAG           Append mode ?
       JEQ  OPWRIT            No
 
*  Open DV/80 in Append mode
 
       BL   @OPEN             Open as DV/80 Append
       DATA >0016
       JMP  ERROR
       JMP  SAVE24
 
*  Open DV/80 file for write
 
OPWRIT BL   @OPEN             Open file for output, variable 80.
       DATA >0012             Open DV write
JLSER2 JMP  ERROR             Error return.
       JMP  SAVE24
 
*  DF/ 80 or 128 file open for write
 
OPA128 SETO @MSFLAG           Set as generic DF/128 flag anyway
OPB128 CLR  @LFLAG            Cancel Line # mode
       MOV  @MLRL,@PABLRL     Set for 128/128
OPENDF BL   @OPEN10           Open as DF/80 or DF/128
       DATA >0002             Open/write
       JMP  JLSER2            Error in DSR
       CLR  R13               Initialize first DF/128 pass
       CLR  R15               Forces first record fetch
 
*  Fetch and write out the records for DV & DF/80
 
SAVE24 BL   @RCDNAM           Record name if flagged
       MOV  @NUM1,@LINENO     Start line # either way
       ABS  @MSFLAG           Special DF/128 ?
       JNE  MSDREC            Yes
       ABS  @PCFLAG           Printer control codes on entry ?
       JEQ  SAVE30            No
       MOVB @PCCENT,R14       Any entered ?
       JEQ  SAVE30
       BL   @MOVE             Fetch codes from VDP storage
       DATA PCEBUV
       DATA LINBUF,24
       JMP  SAVE35            Go write it & then continue
 
*  Normal D/80 records to device
 
SAVE30 BL   @TRECRD           Treat 80 col line to order
       JMP  SAVE40            End of S/P or EoF
SAVE35 BL   @WRECD            Write record out to device
       JMP  JLSER2            Error exit
       JMP  SAVE30            Loop on it till done
 
SAVE40 ABS  @QCFLAG           Printer codes on exit flagged ?
       JEQ  SAVE97            No
       MOVB @PCCEXT,R14
       JEQ  SAVE97
       BL   @MOVE             Prepare record
       DATA PCXBUV            From VDP storage
       DATA LINBUF,24
       BL   @WRECD            Write it out
       JMP  JLSER2            Device error
 
*  Add a tab record at the end
 
SAVE97 ABS  @PFLAG            Check print flag
NOTABS JNE  SAVE99            Changed to JMP for Pr/Ed
       BL   @CONWTB           Construct and write out TAB record
       JMP  JLSER2
SAVE99 BL   @CLOSE            Close file now
       NOP                    IGNORE any close error
EXITLS B    @CMDXIT           Go quit command mode
 
*--------------------------------------
*  MSDOS/UNIX text file write as DF/128
*--------------------------------------
*  MSFLAG acts as generic DF/128 flag
*  Extra chrs spill into SQSBUF
 
*  Write to output device
 
MSDWRI MOVB @WRITE,@PABOC     Set for write
       BL   @IOREC            Go do it
       JMP  JLSER2            Error return
       MOV  R0,R0             Set by TRECD for EoF
       JNE  SAVE99            All done
MSDREC LI   R7,PABBUF         Enter or restart output pointer
MSDW10 MOV  R7,R9             Copy where needed
CTRLD  BLWP @SETVDW           Reset for writing record
 
*  Output/Input loop checks
 
MSDC10 CI   R7,PABBUF+>80     A DF/128 complete ?
       JHE  MSDWRI            Yes - write out record
MSDC20 C    R13,R15           At end of DV/80 record ?
       JHE  MSDRED            Read a fresh record
       MOVB *R13+,@VDPWD      Write to VDP buffer
       INC  R7                Update output pointer
       JMP  MSDC10            Loop on it
 
*  New record from text buffer
 
MSDRED SETO R0                GETLN clears if not EoF
       BL   @TRECRD           Read new record from Text buffer
       JMP  MSDR30            End of range or EoF
       LI   R11,>0D0A         Load with <cr><lf>
       ABS  @UXFLAG           Unix mode ?
       JEQ  MSDR10            No
 
*  Unix line separator
 
       CB   @-1(R15),R11      Last byte a <cr> ?
       JNE  MSDR20            No - write <lf> as following byte
       DEC  R15               Yes - back up
       JMP  MSDR20            Write <lf> over it
 
*  MS-Dos line separator
 
MSDR10 CB   @-1(R15),R11      Last char a <cr> ?
       JEQ  MSDR20            Yes - do not double up
       MOVB R11,*R15+         Write in <cr>
MSDR20 SWPB R11               Bring <lf> to fore
       MOVB R11,*R15+         Write over or after previous
       JMP  MSDR50            Need to reset VDP write pointer
 
*  File terminator
 
MSDR30 ABS  @UXFLAG           Unix
       JEQ  MSDR40            No
       MOVB @CTRLD,*R15+      Write Unix style terminator
       JMP  MSDR50
MSDR40 MOVB @CTRLZ,*R15+      MSDOS text file terminator
MSDR50 LI   R13,LINBUF        Initialize read buffer pointer
       JMP  MSDW10
 
*  Write record to external device
*---------------------------------------------
*  Assumes data at LINBUF & length byte in R14
 
WRECD  EQU  $
       MOV  R11,R15           Save return
WRECE  MOVB R14,@PABCCT       Record length byte
       BL   @C2V              Transfer to VDP
       MOVB @WRITE,@PABOC     Set to write record in opcode
       MOV  R15,R14           Return address for IO
       JMP  IORECW            Write it
 
*  Subroutine to do IO
*---------------------
 
IORCRD EQU  $
       BLWP @FVINIT
IOREAD MOVB @TWO,@PABOC       Set PAB opcode for read
IOREC  MOV  R11,R14           Write in return
IORECW LI   R6,DSRDIR         DSR entry for opened file
       JMP  IORC10            Go do it
 
CLOSE  MOVB @ONE,@PABOC       Set opcode for Close
 
*  Common IO routine
 
IO     EQU  $
       MOV  R11,R14           Set up return
IO05   LI   R6,TWDSLK         Full DSRLNK
       LI   R8,VDPPAB+9       Set up for DSR link.
       MOV  R8,@SCNAME        Already known for re-entry
IORC10 BL   @VMBWD            PAB to VDP
       DATA VDPPAB            Write the PAB for I/O
       DATA PABOC,10          Length byte for PAB data
       BLWP *R6               T-W DSr LinK or DSR DIRect
       DATA 8                 File type access
       JNE  IO10              Error ? - no
 
*  Not found error path
 
       LI   R9,>F             Yes - BadNam
       JMP  IO20              Exit
 
*  Check PAB byte for error
 
IO10   BL   @MOVE             VMBRD as BL
       DATA VDPPAB            Read back the PAB for I/O
       DATA PABOC,10
       MOVB @PABST,R9         Check error code.
       SRL  R9,13
       JNE  IO20              Must have error.
       INCT R14               No error, return
IO20   B    *R14
 
*  Open file, using String pointers, etc.
*----------------------------------------
 
OPEN   EQU  $
OPEN10 MOV  *R11+,@PABOC      Get opcode, and status
       MOV  R11,R14           Save return
       MOV  @PBFNOM,@PABBAD   Set nominal DSR buffer
       MOV  @STRING,R8        String -> file name pointer
       DEC  R8                Point to length byte
       MOVB @STRL1,*R8        Overwrite length
       MOVB *R8,@PABNL        Set up length in CPU PAB
       BL   @VSTRV            Write to VDP
       DATA VDPPAB+10         Where name goes in VDP PAB
       JMP  IO05              Let IO do the work.
 
*  Parse command line
*--------------------
 
PARSLD LI   R8,CTEXT          Point to start of command line
PARSLE MOV  R11,R13           Save return
       BL   @PRNUMS           Parse 1 to 3 numbers
       JMP  PARERL            Error
       MOVB @DSPACE,@DELIM    Use space as filename delimiter
       MOV  R8,@STRING        Start pointer
       BL   @GSLASH           Chase delimiter after name
       JMP  PARERL            None found
       MOV  R6,@STRL          Save length byte
PRLDEX B    *R13              Return
PARERL B    @PARERR           Go to main module error handler
 
 
*  Transfer record to VDP
*------------------------
 
C2V    EQU  $
       LI   R8,LINBUF         Write from LINBUF to PAB buffer
       ABS  @LFLAG            Include line #s ?
       JEQ  C2V10             No
LINSTT EQU  $+2
       LI   R8,LINBF0         Set after line # in LINBUF
C2V10  MOV  @PABBAD,R9        Buffer in PAB
       B    @WRVLIN           In main file
 
*  Purge Text buffer for new file
*-----------------------------------------
*  Fprce buffer contents to one blank line
 
PG01   EQU  $
       LI   R11,CMDXIT        Return to command exit
PURGE  EQU  $
       CLR  @SREGS2           Cursor to first column
       CLR  @PFLAG            Indicate cleared buffer
PURGF  BLWP @INISEG           Initialize text buffer itself
       DECT @TBLND            First entry
       CLR  @TBL-2            Make it blank
       INC  @EOF              Count one line
PURGG  MOVB @AONE,@CRNTAB     Initialize TAB pointer
       CLR  @MKTBL            Reset marker
       CLR  @MKSAV1           Clear for <c-O>
       CLR  @MKSAV3           Also
       CLR  @CHNGED           Reset edited file indicator
       CLR  @PURGED
       CLR  @EOFONS
       CLR  R1                Cline
       CLR  R3                Sbias
       RT
 
*  More L/S/P subroutines
*---------------------------------
*  Initialize flags for Save/Print
*---------------------------------
 
INIFLA EQU  $
       MOV  @SLRL,@PABLRL     Reset for /80 files - bypass for HDpath
INIFLB LI   R6,UFTAB          Point to flag table
INIFLC CLR  *R6+              Clear it out
       CI   R6,UFTBN          End of table
       JL   INIFLC
       CLR  @PABRN            Reset record counter
       RT
 
*--------------------------------------
*  Treat 80 chr record from text buffer
*--------------------------------------
 
TRECRD EQU  $
       MOV  R11,R13           Save return
       CLR  R15               In case of instant exit
       MOV  @LINSTT,@BUFADR   Set up buffer address for GETLiNe
       C    @LINENO,@NUM2     End of save ?
       JH   TREC99            Yes, quit
       BLWP @GETLN            Get line
       MOV  R0,R0             Error?
       JNE  TREC99            Yes, probably EoF
 
*  Eliminate trailing blanks
 
       MOV  @LINENO,R9        Current line #
       BL   @LNDISP
       LI   R14,80            Scan line for last blank.
       ABS  @FFLAG            Fixed 80?
       JNE  TREC20            Yes - no check for length
TREC10 CB   @LNBFM1(R14),@DSPACE  Trailing blank ?
       JNE  TREC20            No - quit search
       DEC  R14               Back one char
       JNE  TREC10            Some left still
       INC  R14               Blank line - give it 1 blank
 
*  Strip control characters
 
TREC20 ABS  @CFLAG            Strip out control?
       JEQ  TREC50            No
       MOV  R14,R6            Yes, get count
TREC30 CB   @LNBFM1(R6),@DSPACE  Control ?
       JGT  TREC40            No
       MOVB @DSPACE,@LNBFM1(R6)   Replace with space
TREC40 DEC  R6                Back 1 char
       JGT  TREC30            Some left
 
*  Add line #s ?
 
TREC50 ABS  @LFLAG            Line #s flagged
       JEQ  TREC60            No
       AI   R14,6             Add 6 to length
       CI   R14,80            Too long ?
       JLT  TREC60            No
       LI   R14,80            Truncate then
TREC60 MOV  R14,R15           Copy length
       SWPB R14               Adjust count in PAB
       INCT R13               Step over for normal return
TREC99 AI   R15,LINBUF        For MS/DOS DF/128
       B    *R13              Direct return is EoF
 
*  Write up current line #
 
LNDISP EQU  $
       MOV  R11,R14
       LI   R10,CPUSCN+80     Use end of first line in buffer
       BL   @BINDEC           Convert to decimal
       LI   R9,LLL-7          Enough room to write 4 digits & 2 blanks
       BL   @VMBWE            Write to end of command line
       DATA CPUSCN+80,6       Where written
       B    *R14
 
*  Construct and write out TAB record
*------------------------------------
 
CONWTB EQU  $
       MOV  R11,R15
       BL   @MOVE             Fetch Tab list
       DATA TABBUV            VDP storage
       DATA LINBUF,66         3 sets worth
       MOVB @MASK80,R11       Set bitmask
       LI   R6,66             Tab records
       MOV  R6,R10            Copy length
       ABS  @TABTYP           Is it Eurowriter mode for tabs ?
       JEQ  CONW10            No
       CLR  R11               Clear bitmask
       INC  R6                For shuffle
 
*  Mask or shuffle
 
CONW10 MOVB @LNBFM1(R10),@LNBFM1(R6)
       SOCB R11,@LNBFM1(R6)
       DEC  R6                Previous target byte
       DEC  R10               Previous source byte
       JGT  CONW10            loop on it
       SWPB R6                Remainder to MSB
       MOV  R6,R14            Null if USA, >0100 if Euro
       JEQ  CONW20            Must be USA
 
*  Write out TAB record as last one
 
       MOVB @BFC,@LINBUF      Euro tab record flag
CONW20 AI   R14,>4200         TAB record length
       B    @WRECE            Write out record
 
*------------------------------------------------------
 
