home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / SORT / SRT12A.LBR / SRT.AQM / SRT.ASM
Assembly Source File  |  2000-06-30  |  49KB  |  1,810 lines
  1. ; SRT.ASM  -  01-MAR-86
  2. ;
  3. THSVER    EQU    12
  4. REVISE    EQU    'a'
  5. ;
  6. ;------------------------------------------------------------------
  7. ;
  8. ;               SRT.ASM
  9. ;
  10. ;         DO ALL THE STUFF WE'VE BEEN WANTING TO....
  11. ;        --- --- --- --- --- --- --- --- --- --- ---
  12. ;        ENABLE REDIRECTED INPUT VIA '<' CONVENTION
  13. ;          (THIS ALLOWS LOWER-CASE SKIP-STRINGS)
  14. ;
  15. ; This is the sort  routine  that I've been  looking for, I hope...
  16. ; Invoke it with no parameters    and it will output the clear-screen
  17. ; string as described below followed by full on-line documentation.
  18. ; Note that  its default  is to re-read the  source  file in random
  19. ; mode after sorting, so if you want to perform an in-core display-
  20. ; save, use  A>SRT out=in ;()K,132 which will produce a maximum key
  21. ; length of 132 characters, beginning  from the start  of the input
  22. ; line and skipping no characters  with the output = the keys.    The
  23. ; program  will tell you  if you run out of core and close any par-
  24. ; tial output file  on the way out.  To sort a bigger file,  simply
  25. ; shorten  the key length  parameter.  The max on my system (end of
  26. ; TPA = 0E000h) and an array base of 0B00h will allow approximately
  27. ; 1800+ lines with a key length of 22 characters.  (The node length
  28. ; is fixed  at 8 bytes).  If you set the key  length to 6, say, for
  29. ; sorting  labels  in a .ASM file, you can sort  about 4200+ lines.
  30. ;
  31. ;
  32. ;     Please call me with any beefs/suggestions/comments!
  33. ;
  34. ;    days: (703)922-5600 Eaton Corporation switchboard.
  35. ;    eves: (301)277-6621 (occasionally...)
  36. ;
  37. ;------------------------------------------------------------------
  38. ;
  39.     $-MACRO
  40.     $-PRINT
  41. ;
  42. ;    MACLIB    ABORT
  43.     MACLIB    EQU
  44.     MACLIB    EXOPCODE
  45.     MACLIB    FILIO
  46.     MACLIB    G80
  47.     MACLIB    MACRO
  48. ;    MACLIB    PARSER
  49. ;    MACLIB    RELOC    ;SEE ALSO XTRAN.LIB
  50. ;    MACLIB    SCR2PRTR
  51. ;    MACLIB    SCHBUF
  52.     MACLIB    SIMPIO
  53.     MACLIB    START
  54.     MACLIB    TEST
  55. ;
  56. ;
  57. ; *** NOTE: ONLY ONE OF THE BELOW TWO LIBRARIES MAY BE USED AT A TIME
  58. ;
  59. ;    USE TRAN FOR FINISHED ROUTINES, TRTST FOR DEBUGGING
  60.     MACLIB    TRAN
  61. ;    MACLIB    TRTST
  62. ;
  63. ;
  64. ; *** END OF TRAN SERIES ***
  65. ;
  66. ;    MACLIB    TXTST
  67. ;    MACLIB    VIDEO
  68. ;    MACLIB    XTRAN        ; RELOCATING 'TRAN' & 'BR'
  69.     MACLIB    Z80
  70. ;
  71. ;SBTTL LOCAL MACRO AREA -----------------------------------
  72. ;
  73. ;SBTTL    OUTPRT- SEND BUFFER TO OUTPUT ROUTINE
  74. ;**********************************************************
  75. ;ASSUMPTIONS:
  76. ;    NOCRT HAS BEEN SET FOR ALL CASES WHERE CRT NOT
  77. ;      DESIRED AS PART OF THE DESTINATION GROUP
  78. ;
  79. OUTPRT     MACRO    BUFFER,STPCHR
  80.      IF    NOT NUL    BUFFER
  81.     LXI    D,BUFFER    ; ; point to source buffer
  82.      ENDIF
  83.      IF    NOT NUL    STPCHR
  84.     MVI    B,STPCHR
  85.      ELSE
  86.     MVI    B,0        ; ;default stop char for us
  87.      ENDIF
  88.     CALL    OUTPUT        ; ;call the routine
  89.      ENDM
  90.  
  91.  
  92. PAGE:
  93. ;;$+PRINT    < < ?? DISK SPACE PROBLEM...
  94. ;;SBTTL EQUATES AREA --------------------------------------
  95.  
  96. DEBUG    EQU    FALSE
  97. SHWPRC    EQU    TRUE        ; Show current process if true
  98.  
  99. SWTCHR    EQU    '/'        ; Switch character
  100.  
  101.      IF    DEBUG
  102. BITKEY    EQU    0        ; Show key & pointer if set
  103. BITLIN    EQU    1        ; Show lines on output if set
  104. BITLN1    EQU    2        ; Show lines on input if set
  105.      ELSE
  106. BITLN1    EQU    2        ; Show lines on input if set
  107.                 ; Key code disabled, lines always
  108.                 ; - displayed on output
  109.      ENDIF
  110.  
  111. BITK06    EQU    6        ; Non-default offset request
  112. BITK80    EQU    7        ; Send key only to output
  113. ;
  114. ;
  115. ;SBTTL    BEGIN EXECUTABLE CODE
  116. ;==========================================================
  117. ;
  118.     SIZ    20,,START
  119. SHWFLG:    DB    6        ; \ what information to show -     140h
  120.                 ; / default is bitlin & bitln1
  121. PRCSHW:    DB    SHWPRC        ;                 141h
  122. DESCND:    DB    FALSE        ; \ set true if descending     142h
  123.                 ; /  - sort required
  124. SWITCH:    DB    SWTCHR        ; Switch character storage
  125. CLSSTR:    DB    1,0CH,0,0,0,0,0,0,0 ; Clear string stuff
  126.     XIT
  127. ;
  128. ERXIT:     IF    DEBUG
  129.     SAVE
  130.      ENDIF
  131.  
  132.     CALL    EOTERX        ; Move long routine to end of task
  133.  
  134.      IF    DEBUG
  135.     UNSAVE
  136.     RST    7
  137.      ENDIF
  138.  
  139. EXIT:    LDA    IGNFLG ! ANA A    ; Did we ignore any lines?
  140.     TRAN    Z,EXIT9        ; No - branch
  141.     PRINTM    IGNMSG        ; Yes - tell the user
  142.  
  143. EXIT9:     IF    DEBUG
  144.     RST    7
  145.      ELSE
  146.     RST    0
  147.      ENDIF
  148. ;
  149. ;
  150. ;SBTTL    START- MAIN LINE CODE LOOP
  151. ;==========================================================
  152. ;
  153. START:    CALL    GETCMD        ; Get & parse command line
  154.     CALL    MAKARY        ; Form the array we'll sort
  155.     CALL    SORT        ; Sort it
  156.     CALL    SHOW        ; Output the results
  157.     CALL    CLOSER        ; Close any output file
  158. START9:    CALL    EXIT        ; Exit with trace
  159.  
  160. PAGE:
  161. ;SBTTL    MAKARY- MAKE ARRAY FROM INPUT FILE
  162. ;==========================================================
  163. ;
  164. MAKARY:    LDA    PRCSHW        ; Show processes?
  165.     ANA    A
  166.     TRAN    Z,MAKAR0    ; No - branch
  167.     QPRINT    SRCMSG        ; 'getting source file information'
  168.  
  169. MAKAR0:     IF    DEBUG
  170.     LXI    H,0        ; \
  171.     SHLD    MEMVAL        ; / init # nodes to 0
  172.     SHLD    CURLIN        ; Init current input line #
  173.     LXI    H,MYDMA        ; \
  174.     SHLD    REDLIN+2    ; / init offset to 0
  175.      ENDIF
  176.  
  177.     CALL    OPNFIL        ; Open input & output files
  178.     CALL    REDREC        ; Read a record (random mode)
  179.     ERROR    NULMSG,C    ; Error if null file
  180.     LHLD    BDOS+1        ; Point to top of memory
  181.     DCX    H        ; Point to even page & leave space
  182.     MVI    L,0
  183.     SHLD    NODTOP        ; Save as marker to end of nodes
  184.     PUSH    H
  185.     POPIX            ; Initialize pointer to nodes
  186.  
  187. MAKAR1:    LHLD    MEMVAL        ; Update # of nodes value
  188.     INX    H
  189.     SHLD    MEMVAL        ; - and resave it
  190.     LXI    D,-NODLEN    ; Length of nodes
  191.     DADX    D        ; Point to first/next node
  192.  
  193. MAKAR2:    CALL    CLRNOD        ; Clear out the new node
  194.     LHLD    ARYPTR        ; Point to base of current key
  195.     STX    ND$STR,L    ; \
  196.     STX    ND$STR+1,H    ; / save it in current node
  197.     PUSHIX            ; ^ \
  198.     POP    H        ; ^ | get the node pointer
  199.     LXI    D,2        ; ^ | into nd$ptr
  200.     DAD    D
  201.     STX    ND$PTR,L    ; ^ |
  202.     STX    ND$PTR+1,H    ; ^ /
  203.     LHLD    CURLIN        ; Get input line number
  204.  
  205.      IF    DEBUG
  206.     STX    ND$LIN,L    ; \
  207.     STX    ND$LIN+1,H    ; / save it in current node
  208.      ENDIF
  209.  
  210.     INX    H        ; Update & resave it
  211.     SHLD    CURLIN
  212.     LHLD    SRCFCB+33    ; Get next record number
  213.     DCX    H        ; - and point back to current
  214.     STX    ND$REC,L    ; \
  215.     STX    ND$REC+1,H    ; / save it in current node
  216.     LHLD    REDLIN+2    ; Get the offset word
  217.     LXI    D,-MYDMA    ; Make it a relative offset
  218.     DAD    D        ; - by subtracting the base address
  219.     STX    ND$OFS,L    ; - save it in current node
  220.  
  221. PAGE:
  222.     CALL    REDLIN        ; Get current line to intbuf
  223.     JRC    MAKAR9        ; Branch on eof
  224.     LDA    SHWFLG        ; Get flag
  225.     BIT    BITLN1,A    ; Show the line?
  226.     JRZ    MAKAR3        ; No - branch
  227.     CALL    SHWINT        ; Yes - show intbuf
  228.  
  229. MAKAR3:    CALL    SUBSTR        ; Save selected substring
  230.     ANA    A        ; Nul length?
  231.     TRAN    NZ,MAKAR4    ; No - branch
  232.     DCR    A        ; \ yes - ignore this line
  233.     STA    IGNFLG
  234.     TRAN    MAKAR2        ; /  - and loop for next
  235.  
  236. MAKAR4:    STX    ND$LEN,A    ; No - save length
  237.     TRAN    MAKAR1        ; - then loop for next
  238.  
  239. MAKAR9:    PUSH    PSW        ; Save flags
  240.     LXI    D,NODLEN    ; Last read fails
  241.     DADX    D        ; - so point to good node
  242.     LHLD    MEMVAL        ; Decrement # nodes
  243.     DCX    H
  244.     SHLD    MEMVAL        ; - and resave it
  245.     SIXD    NODPTR        ; Save pointer to base of nodes
  246.     LHLD    NODPTR        ; \ get top of non-node memory
  247.     MVI    L,0
  248.     SHLD    OUTEND        ; / - and save as top of write buffer
  249.     POP    PSW        ; Restore flags
  250.     RET            ; To calling
  251.  
  252. ;SBTTL    SHWINT- SHOW INTBUF'S CONTENTS
  253. ;==========================================================
  254. ;
  255. SHWINT:    PRINTM    INTBUF+2,,,0    ; Print til trailing nul
  256.     RET            ; To calling
  257.  
  258. ;SBTTL    CLRNOD- CLEAR OUT CURRENT NODE
  259. ;==========================================================
  260. ;
  261. CLRNOD:    PUSHS    B,H        ; Save registers
  262.     MVI    B,NODLEN    ; Length to clear out
  263.     PUSHIX            ; \
  264.     POP    H        ; / put pointer in HL
  265.  
  266. CLRNO1:    MVI    M,0        ; Clear a byte
  267.     INX    H        ; Point to next
  268.     DJNZ    CLRNO1        ; - and loop through node
  269.     POPS    H,B
  270.     RET            ; To calling
  271.  
  272. PAGE:
  273. ;SBTTL    SUBSTR- SAVE SELECTED SUBSTRING TO ARRAY
  274. ;==========================================================
  275. ;
  276. ;ON ENTRANCE:
  277. ;
  278. ;    INTBUF    CONTAINS VALID LINE TO PROCESS
  279. ;    ARYPTR    CONTAINS VALID POINTER TO SUBSTRING ARRAY
  280. ;
  281. ;    IF (SKPSTR) <> 0
  282. ;      SKPSTR CONTAINS SKIP CHARACTERS WITH NULL TERM.
  283. ;     ELSE
  284. ;      OFFSET CONTAINS VALID OFFSET TO BASE OF KEY
  285. ;     ENDIF
  286. ;
  287. ;    KEYLEN    CONTAINS VALID KEY LENGTH (22 IS DEFAULT)
  288. ;
  289. ;ON EXIT:
  290. ;
  291. ;    DESIRED KEY HAS BEEN MOVED TO ARRAY
  292. ;    ARYPTR HAS BEEN UPDATED
  293. ;    'A' CONTAINS LENGTH OF THIS STRING
  294. ;    B,D,H,IX,IY PRESERVED
  295. ;NOTE:
  296. ;    THE ARRAY ENTRY MAY BE OF NULL LENGTH IF SKPSTR <> 0
  297. ;     - AND THE SKIP CHARACTERS WERE NOT FOUND IN THE
  298. ;     - CURRENT INTBUF LINE OR THE OFFSET LENGTH WAS LONGER
  299. ;     - THAN THE INTBUF LINE.
  300. ;
  301. PAGE:
  302. SUBSTR:    PUSHS    B,D,H
  303.     LDA    SKPSTR        ; Any characters to skip?
  304.     ANA    A
  305.     LDA    OFFSET        ; (get offset vector)
  306.     CNZ    SKPSKP        ; Yes - skip them & return offset
  307.     INR    A        ; Offset found?
  308.     TRAN    Z,SUBST9    ; No - split with zero length
  309.     DCR    A        ; Yes - restore length byte
  310.     MOV    E,A        ; - and put it in DE
  311.     MVI    D,0
  312.     LXI    H,INTBUF+1    ; Point to source's length
  313.     MOV    B,M        ; Get it & point to first ASCII
  314.     INX    H
  315.     CMP    B        ; Line long enough?
  316.     JRC    SUBST0        ; Yes - branch
  317.     XRA    A        ; No - return zero as length
  318.     TRAN    SUBST9        ; - and goto common exit
  319. ;
  320. SUBST0:    DAD    D        ; Yes - form absolute offset
  321.     LDED    ARYPTR        ; Get current array pointer
  322.     LDA    KEYLEN        ; Get key length
  323.     MOV    B,A
  324.     MVI    C,0        ; Init length of this string
  325.  
  326. SUBST1:    ANA    A        ; End of line found?
  327.     JRZ    SUBST3        ; Yes - split
  328.     MOV    A,M        ; No - get a character
  329.     STAX    D        ; - and move it
  330.     INX    D        ; Point to next source, dest
  331.     INX    H
  332.     INR    C        ; Increment length counter
  333.     DJNZ    SUBST1        ; - and loop
  334.  
  335. SUBST3:    XCHG
  336.     MVI    M,0        ; Form trailing null
  337.     INX    H        ; Claim space for null
  338.     SHLD    ARYPTR        ; Save array pointer
  339.     MOV    A,C        ; Return string length in a
  340.     PUSHIX            ; \
  341.     POP    D        ; / get current node pointer
  342.     CMPHD            ; Out of space yet?
  343.     ERROR    '+++ Out of node space',NC
  344.  
  345. SUBST9:    POPS    H,D,B
  346.     RET            ; To calling
  347.  
  348. PAGE:
  349. ;SBTTL    REDREC- READ A RECORD IN RANDOM MODE
  350. ;==========================================================
  351. ;
  352. REDREC:    CONSOLCHR BREAK,CLSABT    ; Goto close&abort if user desires
  353.     READR    SRCFCB,MYDMA    ; Read a record to mydma
  354.     JRC    REDRE9        ; Branch on eof
  355.     CALL    RESDMA        ; Reset high bits in buffer
  356.     PNTNXT    SRCFCB        ; Point to next record
  357.     XRA    A        ; Clear carry
  358.  
  359. REDRE9:    RET            ; - with status
  360.  
  361. ;SBTTL    RESDMA- RESET HIGH BITS IN DMA BUFFER
  362. ;==========================================================
  363. ;
  364. RESDMA:    LXI    H,MYDMA        ; Point to base of buffer
  365.     MVI    B,80H        ; Buffer length
  366. RESDM1:    RES    7,M        ; Reset the high bit
  367.     INX    H        ; Point to next
  368.     DJNZ    RESDM1        ; - and loop through buffer
  369.     RET            ; To calling
  370.  
  371. ;SBTTL    REDLIN- READ A LINE FROM MYDMA
  372. ;==========================================================
  373. ;
  374. REDLIN:    GETLIN    REDREC,MYDMA,INTBUF ; Get a line to intbuf
  375.     JRC    REDLI9        ; Split if error
  376.     LXI    D,INTBUF+2    ; Point to ascii
  377. REDLI9:    RET            ; - with status
  378.  
  379. ;SBTTL    CLSABT-, CLOSER- CLOSE ANY OUTPUT FILE
  380. ;==========================================================
  381. ;
  382. CLSABT:    LXI    H,DSTFCB
  383.     LXI    D,NEWNAM    ; 'filename.$$$' fcb
  384.     LXI    B,9        ; Don't include .typ field
  385.     LDIR    0        ; Make rename fcb
  386.     CALL    CLOSER        ; Close any output file
  387.     RENAME1    DSTFCB,NEWNAM    ; Rename the file
  388.     ERROR    '+++ Aborting at user request.'
  389.  
  390. CLOSER:    LDA    DSTFCB+1 ! CPI SPACE ; Valid file name?
  391.     TRAN    Z,CLOSE9    ; No - split
  392.     CALL    WRITER        ; Yes - flush buffer
  393.     CLOSE    DSTFCB        ; - and close file
  394.     ERROR    CLSERR,C    ; Report any error
  395.  
  396. CLOSE9:    RET            ; To calling
  397.  
  398. PAGE:
  399. ;SBTTL    SKPSKP- SKIP THE SKIP_CHARACTER STRING
  400. ;==========================================================
  401. ;RETURN -1 IF END OF STRING REACHED BEFORE END OF SKIP_CHAR STRING
  402. ; ELSE RETURN LENGTH OF SKIP STRING IN 'A'
  403. ;
  404. SKPSKP:    PUSHS    B,D,H        ; Save other registers
  405.     LXI    H,INTBUF+1    ; Yes - point to length byte
  406.     MOV    C,M        ; Make length word of it
  407.     MVI    B,0
  408.     INX    H        ; - and point to first char
  409.     LXI    D,SKPSTR    ; Point to buffer
  410.     LDA    CTGSWI        ; Contiguous string request?
  411.     ANA    A
  412.     JRZ    SKPSK1        ; No - split
  413.     LDAX    D        ; Yes - get a character
  414.     CCIR            ; Look for it
  415.     JPO    SKPSK8        ; Not found - split
  416.     LDA    SKPLEN        ; Get length of skip string
  417.     MOV    B,A
  418.     DCX    H        ; Point back to first character
  419.     CALL    CMPSTR        ; - and compare the strings
  420.     JRNZ    SKPSK8        ; Split if no match
  421.     JR    SKPSK6        ; - else pick up skip length
  422.  
  423. SKPSK1:    LDAX    D        ; Get a character
  424.  
  425. SKPSK5:    CCIR            ; Look for it
  426.     JPO    SKPSK8        ; Not found - split
  427.     INX    D        ; Get next skip character
  428.     LDAX    D
  429.     ANA    A        ; Null?
  430.     JRNZ    SKPSK5        ; No - loop for next
  431.  
  432. SKPSK6:    LXI    D,-(INTBUF+2)    ; Negated base of ascii line
  433.     LDA    SHWFLG        ; Get sense of switch
  434.     BIT    BITK06,A    ; Special offset request?
  435.     JRZ    SKPSK7        ; No - branch
  436.     LDA    OFFSET        ; Yes - get offset value
  437.     JR    SKPSK9        ; - and split to common exit
  438.  
  439. SKPSK7:    DAD    D        ; Get offset in hl
  440.     MOV    A,L        ; - (actual length is in l)
  441.     JR    SKPSK9        ; All done - declare success
  442.  
  443. SKPSK8:    MVI    A,-1        ; Declare failure
  444.  
  445. SKPSK9:    POPS    H,D,B        ; Restore registers
  446.     RET            ; To calling
  447.  
  448. PAGE:
  449. ;SBTTL    SORT- SORT THE ARRAY
  450. ;==============================================================
  451. ;
  452. ; *** NOTE THAT THE ORIGINAL CODE FOR THIS ROUTINE MAY BE FOUND
  453. ; *** AS PART OF BACKUP.ASM
  454. ;
  455. SORT:    LDA    DESCND        ; Descending order sort request?
  456.     ANA    A
  457.     JRZ    SORT0        ; No
  458.     MVI    A,JC        ; Yes - 0dah = 'jc dest'
  459.     STA    NEQ        ;
  460.  
  461. SORT0:    LDA    PRCSHW        ; Show processes?
  462.     ANA    A
  463.     TRAN    Z,SORT1        ; No - branch
  464.     QWRITE    <SORTING THE FILE>
  465.  
  466. SORT1:    LHLD    MEMVAL        ; Get record count
  467.     SHLD    N1        ; - and initialize
  468.     SHLD    M1        ; - values
  469.     LXI    H,NODLEN    ; Get node size
  470.     SHLD    K1        ; - and save it for sort
  471.     LHLD    NODPTR        ; Point to base of array
  472.     SHLD    J1        ; - for sort
  473.     CALL    SHELLM        ; Call the routine
  474.     LDA    PRCSHW ! ANA A    ; Show processes?
  475.     TRAN    Z,SORT9        ; No - branch
  476.     QWRITE    <DONE SORTING>
  477.  
  478. SORT9:    RET            ; Finished sorting
  479.  
  480. ;SBTTL    SHELLM- from KILOBAUD april 1981 p164
  481. ;==============================================================
  482. ;
  483. ; Remark 'For fixed length records stored in memory put noumber
  484. ; of records in N1 and M1.  The length of each record is stored
  485. ; at K1, and the starting address at J1.  Start sort by calling
  486. ; location  "SHELLM".  To change to descending sort, change the
  487. ; byte at NEQ: to DAH. - instruction = "JC NSW"'
  488. ;
  489. N1:    DW    0        ; Number of records
  490. M1:    DW    0        ; Same here
  491. K1:    DW    0        ; Length of records
  492. J1:    DW    0        ; Starting address of strings
  493. I1:    DW    0        ; Ptr
  494. ML1:    DW    0        ; Ptr
  495. DJ1:    DW    0        ; Ptr
  496. DI1:    DW    0        ; Ptr
  497. ;
  498. SHELLM:    LHLD    J1        ; Get start address
  499. ;    $-PRINT
  500.  
  501. PAGE:
  502.     PUSH    H        ; Save
  503.     LHLD    K1        ; Get length
  504.     PUSH    H        ; It too
  505.  
  506. DIV:    XRA    A        ; M1=m1/2
  507.     LHLD    M1
  508.     MOV    A,H
  509.     RAR
  510.     MOV    H,A
  511.     MOV    A,L
  512.     RAR
  513.     MOV    L,A
  514.     SHLD    M1        ; Save new m1
  515. ;
  516.     ORA    H        ; Check if done
  517. ;;    JNZ    NDON        ;*Original instruction
  518.     JRNZ    NDON        ; *
  519.     POP    B        ; Finished
  520.     POP    D        ; So return
  521.     RET            ; Now
  522.  
  523. PAGE:
  524. ;SBTTL    NDON- set k1=n1-m1
  525. ;==========================================================
  526.  
  527. NDON:    XCHG            ; M1 to DE
  528.     LHLD    N1
  529.     MOV    A,L
  530.     SUB    E
  531.     MOV    L,A
  532.     MOV    A,H
  533.     SBB    D
  534.     MOV    H,A
  535.     SHLD    K1
  536.     LXI    H,1        ; Set and save i=j=1
  537.     SHLD    J1
  538.     SHLD    I1
  539. ;
  540. ; Calculate and save address offset = M1*I1
  541. ;
  542.     DCR    L
  543.     POP    B        ; Length of str=i1
  544.     PUSH    B        ; Put it back
  545.  
  546. LP1:    DAD    D
  547.     DCX    B
  548.     MOV    A,B
  549.     ORA    C
  550. ;;    JNZ    LP1
  551.     JRNZ    LP1
  552.     SHLD    ML1
  553. ;
  554.     XCHG            ; Calc & save d(j), d(i), d(i+m)
  555.     POP    B
  556.     POP    H
  557.     PUSH    H
  558.     PUSH    B
  559.  
  560. LP2:    SHLD    DJ1
  561.     SHLD    DI1
  562.     XCHG
  563.     DAD    D
  564.     XCHG            ; Hl has d(i), de has d(i+m)
  565.  
  566. PAGE:
  567. ;SBTTL    CP1- compare strings and switch
  568. ;==========================================================
  569. ;
  570. CP1:    POP    BC        ; Put valid length in bc (for shellm's use)
  571.     PUSH    BC
  572.     CALL    COMPAR        ; Perform actual comparison routine
  573.     JZ    NSW        ; If done, don't switch
  574. ;
  575. ;
  576. ; Change next instruction to JC for descending
  577. ;
  578. NEQ:    JNC    NSW        ; If d(i)<d(i+m) don't switch
  579. SW:    MVI    B,2        ; Only swapping one word
  580. SW1:    MOV    C,M
  581.     LDAX    D
  582.     MOV    M,A
  583.     MOV    A,C
  584.     STAX    D
  585.     INX    H
  586.     INX    D
  587.     DJNZ    SW1
  588. ;
  589. ;
  590. ; Strings switched, chk if I1-M1 < 1
  591. ;
  592. ; * NOTE THAT BY COMMENTING THE INSTRUCTIONS WITH TRAILING ';*''S
  593. ; * AND UNCOMMENTING THOSE THAT ARE CURRENTLY COMMENTED WITH ';*'
  594. ; * THE DSBC CODE MAY BE TESTED FOR POSSIBLE REPLACEMENT.
  595. ; * - BE SURE TO CHECK THE TIMING, TOO...
  596. ; *
  597.     LHLD    M1        ; *
  598.     MOV    A,H        ; *
  599.     CMA            ; *
  600.     MOV    D,A        ; *
  601.     MOV    A,L        ; *
  602.     CMA            ; *
  603.     MOV    E,A        ; *
  604. ;;*    LDED    M1    ; GET POINTER
  605. ;;*    XRA    A    ; CLEAR CARRY
  606.     LHLD    I1
  607. ;;*    DSBC    D    ;GET THE REMAINDER
  608. ;
  609.     DAD    D        ; If i1-m1<1 then jump to same as
  610.                 ; No switch
  611.     JNC    NSW
  612.  
  613. PAGE:
  614. ;SBTTL    calc new d(i), d(i+m)
  615. ;==========================================================
  616. ;
  617.     INX    H        ; Save    new i1=i1-m
  618.     SHLD    I1
  619.     LHLD    DI1        ; Old d(i)=new d(i+m)
  620.     XCHG
  621.     LHLD    ML1        ; Address offset
  622.     MOV    A,E        ; New d(i)=old d(i)-offset
  623.     SUB    L
  624.     MOV    L,A
  625.     MOV    A,D
  626.     SBB    H
  627.     MOV    H,A
  628.     SHLD    DI1        ; Save new d(i)
  629.     JMP    CP1        ; Goto compare strings
  630.  
  631. ;SBTTL    NSW- check for j>k
  632. ;==========================================================
  633. ;
  634. NSW:    LHLD    J1
  635.     INX    H        ; Save new j=old j+1
  636.     SHLD    J1
  637.     SHLD    I1
  638.     XCHG
  639.     LHLD    K1
  640.     MOV    A,L
  641.     SUB    E
  642.     MOV    A,H
  643.     SBB    D
  644.     JC    DIV        ; If j>k goto beginning and
  645.                 ; Divide M1
  646.  
  647. ;SBTTL    calc new d(j), d(i)
  648. ;==========================================================
  649. ;
  650.     LHLD    DJ1
  651.     POP    D
  652.     PUSH    D
  653.     DAD    D        ; New d(j)=old d(j+1)
  654.     XCHG
  655.     LHLD    ML1
  656.     XCHG
  657.     JMP    LP2
  658.  
  659. ;;    $+PRINT
  660. PAGE:
  661. ;SBTTL    COMPAR- COMPARISON ROUTINE
  662. ;==========================================================
  663. ;
  664. COMPAR:    PUSHS    B,D,H
  665.     MOV    A,M        ; ^\ get hl's node pointer -
  666.     INX    H
  667.     MOV    H,M        ; ^/ - into HL
  668.     MOV    L,A
  669.     XCHG            ; ^
  670.     MOV    A,M        ; ^\ get de's node pointer -
  671.     INX    H
  672.     MOV    H,M        ; ^/ - into -
  673.     MOV    L,A
  674.     XCHG            ; ^  - de
  675.     PUSHS    D,H
  676.     LXI    D,ND$LEN-2    ; Point to length byte of node
  677.     DAD    D
  678.     MOV    B,M        ; Get hl(string)'s length
  679.     POPS    H,D
  680.     PUSHS    D,H
  681.     LXI    H,ND$LEN-2
  682.     DAD    D
  683.     MOV    A,M        ; Get de(string)'s length
  684.     POPS    H,D        ; Restore pointer registers
  685.     CMP    B        ; Which is longer?
  686.     JRC    COMPA1        ; Already have longer - branch
  687.     MOV    B,A        ; Put longer length in 'b'
  688.  
  689. COMPA1:    MOV    A,M
  690.     INX    H
  691.     MOV    H,M        ; HL = (HL)
  692.     MOV L,A
  693.     XCHG
  694.     MOV    A,M
  695.     INX    H
  696.     MOV    H,M        ; DE = (DE)
  697.     MOV    L,A
  698.     XCHG
  699.     CALL    CMPSTR        ; Compare the strings
  700.     JRNZ    COMPA8        ; - branch if unequal
  701.     MOV    A,D        ; - else ensure original
  702.     CMP    H        ; - address order
  703.     JRNZ    COMPA8
  704.     MOV    A,E
  705.     CMP    L
  706.  
  707. COMPA8:    POPS    H,D,B        ; Preserve flag information
  708.     RET            ; To calling
  709.  
  710. ;SBTTL    CMPSTR- COMPARE STRINGS @ HL, DE FOR LENGTH 'B'
  711. ;==========================================================
  712. ;
  713. CMPSTR:    LDAX    D        ; Get a character
  714.     CMP    M        ; - and compare
  715.     JRNZ    CMPST9        ; Branch on first failure
  716.     INX    D        ; Point to next char
  717.     INX    H        ; Point to next char
  718.     DJNZ    CMPSTR
  719.  
  720. CMPST9:    RET            ; To calling
  721.  
  722. PAGE:
  723. ;SBTTL    SHOW- DISPLAY THE ARRAY CONTENTS TO CRT
  724. ;==========================================================
  725. ;
  726. SHOW:     IF    DEBUG
  727.     LXI    H,0
  728.     SHLD    CURLON        ; Init current output line #
  729.      ENDIF
  730.     CALL    MAKEOF        ; Init the write buffer
  731.     CALL    QQCRLF        ; Fresh line to start
  732.     LIXD    NODPTR        ; Point to base of array
  733.     LXI    D,NODLEN    ; Element length
  734.     LBCD    MEMVAL        ; Number of elements
  735.     JR    SHOW2        ; Skip first increment
  736.  
  737. SHOW1:    DADX    D        ; Point to next element
  738.  
  739. SHOW2:    CALL    SHWVAL        ; Show a value & write it to output
  740.     DCX    B        ; Account for usage
  741.     MOV    A,B        ; Done?
  742.     ORZ    C
  743.     JRNZ    SHOW1        ; No - loop
  744.     RET            ; Yes - return to calling
  745.  
  746. PAGE:
  747. ;SBTTL    SHWVAL- SHOW A VALUE TO THE USER
  748. ;==========================================================
  749. ;
  750. ;ON ENTRANCE:
  751. ;
  752. ;    IX POINTS TO CURRENT NODE
  753. ;
  754. SHWVAL:     IF    DEBUG
  755.     SAVE            ; Save all 8080 registers
  756.     LDX    L,ND$PTR    ; \
  757.     LDX    H,ND$PTR+1    ; / point to node in hl
  758.     DCX    H        ; Offset the pointer to account for nd$ptr
  759.     DCX    H
  760.     PUSH    H        ; \
  761.     POPIY            ; / put adjusted pointer in iy
  762.     LDA    SHWFLG        ; Get flag
  763.     BIT    BITKEY,A    ; Show the key?
  764.     TRAN    Z,SHWVA9    ; No - branch
  765.     PRINTM    KEYMSG        ; Print key string address msg
  766.     LDY    L,ND$STR    ; \
  767.     LDY    H,ND$STR+1    ; / get the key string address
  768.     PUSH    H        ; - and save it
  769.     HEXOUT            ; Output it
  770.     PRINTM    INLMSG        ; Print input line number message
  771.     LDY    L,ND$LIN    ; \
  772.     LDY    H,ND$LIN+1    ; / get input line number
  773.     HEXOUT            ; Output it
  774.     PRINTM    SPCMSG        ; Output a space or two
  775.     POP    D        ; Restore pointer to key
  776.  
  777. SHWVA1:    LDAX    D        ; Get a character
  778.     ANA    A        ; Done?
  779.     JRZ    SHWVA9        ; Yes - split
  780.     PUSH    D        ; No - save pointer & move char
  781.     MOV    E,A
  782.     MVI    C,CONOUT    ; - and output it to crt
  783.     CALL    BDOS
  784.     POP    D        ; Retrieve & point to next
  785.     INX    D
  786.     JR    SHWVA1        ; - and loop for next
  787.  
  788. SHWVA9:    CALL    QQCRLF        ; To separate lines
  789.     UNSAVE            ; Restore all registers
  790.     LDA    SHWFLG        ; Get flag
  791.     BIT    BITLIN,A    ; Show the line?
  792.     JRZ    SHWVAZ        ; No - branch
  793.      ENDIF
  794.  
  795.     CALL    SHWLIN        ; Show input line
  796.  
  797. SHWVAZ:    RET            ; To calling
  798.  
  799. PAGE:
  800. ;SBTTL    SHWLIN- SHOW SOURCE FILE LINE OR KEY
  801. ;==========================================================
  802. ;
  803. SHWLIN:    SAVE            ; Save all 8080 registers
  804.     LDX    L,ND$PTR    ; \
  805.     LDX    H,ND$PTR+1    ; / point to node in hl
  806.     DCX    H        ; Offset the pointer to account for nd$ptr
  807.     DCX    H
  808.     PUSH    H        ; \
  809.     POPIY            ; / put adjusted pointer in iy
  810.  
  811.      IF    DEBUG
  812.     LDY    L,ND$LIN    ; \
  813.     LDY    H,ND$LIN+1    ; / get source file line #
  814.     PUSH    H        ; - and save it
  815.     PRINTM    OUTMSG        ; - print source file line # message
  816.     POP    H        ; Retrieve line #
  817.     DECOUT    ,<SUPPRESS OR CON> ; - and send to crt
  818.      ENDIF
  819.  
  820.     LDA    SHWFLG        ; Get contents
  821.     BIT    BITK80,A    ; Display keys only?
  822.     TRAN    Z,SHWLI5    ; No - branch
  823.     LDY    E,ND$STR    ; \ yes -
  824.     LDY    D,ND$STR+1    ; / get the key string address
  825.     LDY    L,ND$LEN    ; Get length of current line
  826.     MVI    H,0        ; Point to end of line
  827.     DAD    D
  828.  
  829. SHWLI0:    DCX    H        ; Get last character
  830.     MOV    A,M
  831.     ANA    A        ; Null term character?
  832.     JRZ    SHWLI0        ; Yes - loop for previous
  833.     CPI    LF        ; Crlf in place?
  834.     JRZ    SHWLI0        ; Yes - loop for previous
  835.     CPI    CR        ; Half a crlf?
  836.     JRNZ    SHWLI2        ; No - send line as is
  837.     MVI    M,0        ; Yes - truncate it
  838.  
  839. SHWLI2:    OUTPRT            ; - and output line
  840.  
  841. SHWLI3:    OUTPRT    CRBUF        ; Yes - output it
  842.     TRAN    SHWLI9        ; - and split
  843.  
  844. SHWLI5:    LDY    L,ND$REC    ; \
  845.     LDY    H,ND$REC+1    ; / get record number
  846.     SHLD    SRCFCB+33    ; - set it
  847.     LDY    E,ND$OFS    ; Get offset within record
  848.     MVI    D,0        ; Form word offset
  849.     LXI    H,MYDMA        ; Base of dma buffer
  850.     DAD    D        ; Form absolute offset
  851.     SHLD    REDLIN+2    ; Save it for getlin's use
  852.     CALL    REDREC        ; Read the record
  853.     ERROR    '+++ bad read - aborting.',C
  854.     CALL    REDLIN        ; Read the line
  855.     OUTPRT    INTBUF+2    ; Send line to output devices
  856.  
  857. SHWLI9:    UNSAVE            ; Restore all 8080 registers
  858.     RET            ; To calling
  859.  
  860. ;SBTTL    MAKEOF- INITIALIZE OUTPUT BUFFER & POINTERS
  861. ;**********************************************************
  862. ;
  863. MAKEOF:    LDA    DSTFCB+1
  864.     CPI    SPACE
  865.     TRAN    Z,MAKEO9    ; No file - split immediatly
  866.  
  867.      IF    DEBUG
  868.     LDA    SHWFLG        ; \
  869.     RES    BITKEY,A    ; | make sure we don't try
  870.     STA    SHWFLG        ; /  - to show keys...
  871.      ENDIF
  872.  
  873.     PUSHS    B,D,H
  874.     LXI    H,SHWFLG
  875.     BIT    BITK80,M    ; Save the keys to the output file?
  876.     JRZ    MAKEO3        ; No - branch
  877.     CALL    MAKALT        ; Yes - make alternate arrangements
  878.     TRAN    MAKEO8        ; - then branch to common exit
  879.  
  880. MAKEO3:    LHLD    OUTEND        ; Get pointer to end of buffer
  881.     LXI    B,-ARRAY    ; Base of buffer
  882.     DAD    B
  883.     PUSH    H        ; Form length in BC
  884.     POP    B
  885.     DCX    B        ; - and avoid off-by-one error
  886.     LXI    H,ARRAY        ; Point to base of buffer
  887.     SHLD    OUTBAS        ; - and save it as base output buffer
  888.     SHLD    OUTPTR        ; - init output pointer, too
  889.     MVI    M,1AH        ; Character with which to fill
  890.     LXI    D,ARRAY+1    ; Prepare for fill operation
  891.     LDIR    0        ; Fill the buffer
  892.  
  893. MAKEO8:    POPS    H,D,B
  894.  
  895. MAKEO9:    RET            ; To calling
  896.  
  897. ;SBTTL    MAKALT- MAKE ALTERNATE OUTPUT FILE BUFFER ARRANGEMENTS
  898. ;==========================================================
  899. ;
  900. MAKALT:    LHLD    ARYPTR        ; Get pointer to end of key array
  901.     INR    H        ; Form safe xx00h value
  902.     MVI    L,0
  903.     SHLD    OUTBAS        ; - and save it as base output buffer
  904.     SHLD    OUTPTR        ; - init output pointer, too
  905.     LDED    NODPTR        ; Get base of node array
  906.     CMPHD            ; - and test
  907.     ERROR    MAKMSG,NC    ;
  908.     PUSHS    H,H        ; Save pointer for restoration, replication
  909.     LDED    OUTEND        ; Get end of output buffer pointer
  910.     XCHG            ; Set up for subtraction
  911.     XRA    A
  912.     DSBC    D        ; Form remainder
  913.     PUSH    H        ; - and put it in bc
  914.     POPS    B,D,H        ; - and restore pointers
  915.     INX    D        ; Point to next
  916.     MVI    M,CTLZ        ; Initialize fill byte
  917.     LDIR    0        ; - and the rest of the buffer
  918.     RET            ; To calling
  919.  
  920. PAGE:
  921. ;SBTTL    OUTPUT- ALL 'OUTPRT' REQUESTS COME HERE
  922. ;**********************************************************
  923. ;
  924. OUTPUT:    LDA    DSTFLG        ; Set destination
  925.     MOV    C,A
  926.  
  927. OUTPU1:    PUSHS    B,D        ; Save registers
  928.     CALL    @PRINTM        ; Print the line
  929.     POPS    D,B        ; Restore registers
  930.     LDA    DSTFCB+1    ; Test for file
  931.     CPI    SPACE        ; Valid file name?
  932.     JRZ    OUTPU9        ; No - branch to common exit
  933.     CALL    PUTIT        ; Yes - send line to file
  934.  
  935. OUTPU9:    RET            ; To calling
  936.  
  937. ;SBTTL    WRITER- WRITE A BLOCK
  938. ;**********************************************************
  939. ;
  940. WRITER:    SAVE            ; Save all 8080 registers
  941.     LHLD    OUTBAS        ; Get base of output
  942.     LXI    D,-80H        ; \
  943.     DAD    D        ; / - and predecrement it
  944.     PUSH    H        ; Prepare to pop
  945.  
  946. WRITE1:    POP    H        ; Retrieve pointer
  947.     LXI    D,80H        ; Offset to first/next buffer
  948.     DAD    D        ; Form current pointer in hl
  949.     XCHG            ; - and swap it to de
  950.     LHLD    OUTPTR        ; Retrieve e_o_buffer pointer
  951.     CMPHD            ; Are we done?
  952.     TRAN    C,WRITE9    ; Yes - split
  953.     PUSH    D        ; No - save pointer
  954.     WRITES    DSTFCB,,WRITEX    ; Write a 128. byte buffer
  955.     TRAN    WRITE1        ; - and loop for possible next
  956.  
  957. WRITE9:    CALL    MAKEOF        ; Fill the buffer with eof markers
  958.     UNSAVE            ; Restore all 8080 registers
  959.     LHLD    OUTBAS        ; Reset output pointer to base of buffer
  960.  
  961. WRITEZ:    RET            ; To calling
  962.  
  963. WRITEX:    ERROR    '+++ disk full'    ; Error exit for write
  964.  
  965. PAGE:
  966. ;SBTTL    PUTIT- WRITE A LINE TO OUTPUT FILE
  967. ;**********************************************************
  968. ;    PUTTMP    WRITER,ARRAY,OUTEND,OUTPTR
  969. ; THE CODE BELOW USES THE PUTTMP MACRO (ABOVE) AS ITS
  970. ; SOURCE - THE UNALTERED MACRO IS FOUND IN FILIO.LIB
  971. ;
  972. PUTIT:    LHLD    OUTPTR        ; Get current outbuf pointer
  973.  
  974. PUTIT1:    LDAX    D        ; Get a char & point to next
  975.     INX    D
  976.     ANA    A        ; End of buffer?
  977.     JRZ    PUTIT9        ; Yes - split
  978.     MOV    M,A        ; No - move the character in
  979.     INX    H        ; Point to next destination
  980.     PUSH    D        ; Save input pointer
  981.     LDED    OUTEND        ; Get end of our buffer
  982.     CMPHD            ; Full buffer?
  983.     JRC    PUTIT2        ; No - branch
  984.     CALL    WRITER        ; Yes - write to disk &
  985.     LHLD    OUTBAS        ; - reset output pointer
  986.  
  987. PUTIT2:    POP    D        ; Restore input pointer
  988.     JR    PUTIT1        ; - then loop for next char
  989.  
  990. PUTIT9:    SHLD    OUTPTR        ; Save pointer for next
  991.     RET            ; To calling
  992.  
  993. ;SBTTL    QQCRLF- CRLF TO CRT - ALL REGISTERS PRESERVED
  994. ;==========================================================
  995. ;
  996. QQCRLF:    SAVE
  997.     CALL    QQCRL0
  998.     UNSAVE
  999.     RET            ; To calling
  1000.  
  1001. QQCRL0:    MVI    E,CR
  1002.     CALL    QQCRL1
  1003.     MVI    E,LF
  1004. QQCRL1:    MVI    C,CONOUT
  1005.     CALL    BDOS
  1006.     RET            ; To qqcrlf/calling
  1007.  
  1008. PAGE:
  1009. ;SBTTL    EOTERX- CLEAR SCREEN ROUTINE FOR ERXIT
  1010. ;==========================================================
  1011. ;
  1012. EOTERX:    LXI    H,MENU        ; Get known address
  1013.     CMPHD            ; Menu request?
  1014.     JRNZ    ERXIT2        ; No - branch
  1015.     LXI    H,CLSSTR    ; Yes - point to cls buffer
  1016.     MOV    B,M        ; Get length byte
  1017.     MOV    A,B        ; Null string?
  1018.     ANA    A
  1019.     JRZ    ERXIT1        ; Yes - split
  1020.  
  1021. ERXIT0:    INX    H        ; No - get a character
  1022.     MOV    E,M
  1023.     PUSHS    B,H        ; Save the counter & pointer
  1024.     MVI    C,CONOUT    ; Output the character
  1025.     CALL    BDOS
  1026.     POPS    H,B        ; Restore pointer & counter
  1027.     DJNZ    ERXIT0        ; - and loop for next char
  1028.  
  1029. ERXIT1:    LXI    D,MENU        ; Point to the original msg
  1030.  
  1031. ERXIT2:    LDAX    D        ; Follow the exit status convention
  1032.     STA    MAGICSTATUS
  1033.     MVI    C,PRTSTR    ; Print the message
  1034.  
  1035.      IF    DEBUG
  1036.     CALL    BDOS        ; For tracing
  1037.     RET
  1038.      ELSE
  1039.     JMP    BDOS        ; For task size & execution speed
  1040.      ENDIF
  1041. PAGE:
  1042. ;SBTTL    DATA & BUFFER AREAS
  1043. ;==========================================================
  1044. ;
  1045. DSTFLG:    DB    CON        ; Console only destination
  1046. OUTPTR:    DW    0        ; Output pointer
  1047. OUTBAS:    DW    0        ; Base of output buffer
  1048. OUTEND:    DW    0        ; Top of write buffer pointer (xx00h)
  1049.  
  1050.      IF    DEBUG
  1051. FCBFLG:    DB    0        ; Fcb move/no request flag
  1052.      ENDIF
  1053.  
  1054. CRBUF:    DB    CR,LF,0        ; Buffer for outprt's use
  1055. MYDMA:    DS    80H        ; Input dma buffer
  1056. INTBUF:    DB    255        ; Maximum length of line
  1057.     DB    0        ; Length of current line
  1058.     DS    256        ; + trailing null
  1059. ;
  1060. ;
  1061. ; ------ KEY RELATED STUFF ---------------
  1062. ;
  1063. IGNFLG:    DB    0        ; If set, tell user we ignored some lines
  1064. CURLIN:    DW    0        ; Current input line number
  1065. CURLON:    DW    0        ; Current output line counter
  1066.  
  1067. ;BITKEY EQU    0        ;SHOW KEY & POINTER IF SET
  1068. ;BITLIN EQU    1        ;SHOW SOURCE LINE IF SET
  1069. ;BITLN1 EQU    2        ;SHOW LINES IN MAKARY IF SET
  1070. CTGSWI:    DB    0        ; Contiguous skipstring request flag
  1071. OFFSET:    DB    0        ; Offset to skip
  1072. KEYLEN:    DB    22        ; Default (from j.m.c.jr.)
  1073. SKPLEN:    DB    0        ; Length of skip string
  1074. SKPSTR:    DB    0        ; Serves as flag byte
  1075.     DS    20        ; Maximum length of skip string
  1076.  
  1077. PAGE:
  1078. ; ------ NODE POINTERS -------------------
  1079. ;
  1080. NODPTR:    DW    0        ; Pointer to base of nodes
  1081. NODTOP:    DW    0        ; Address after last node
  1082. ARYPTR:    DW    ARRAY        ; Pointer to next available substring
  1083. MEMVAL:    DW    0        ; Number of nodes constructed
  1084. ;
  1085. ;
  1086. ; ------ ERROR & OTHER MESSAGES ----------
  1087. ;
  1088. OPNPTR:    DW    OPNERR        ; Error pointer
  1089.  
  1090.      IF    DEBUG
  1091. SPCMSG:    DB    '  $'        ; Space message
  1092. INLMSG:    DB    ' line #> $'    ; Input line number
  1093. OUTMSG:    DB    ' olin #> $'    ; Output line number
  1094. KEYMSG:    DB    '  key #> $'    ; Key pointer value
  1095.      ENDIF
  1096.  
  1097. CLSERR:    DB    CR,LF,'+++ Error - can''t close output file!$'
  1098. MAKMSG:    DB    CR,LF,'+++ No space for output file.$'
  1099. OH$OH:    DB    CR,LF,'File exists - erase it? $'
  1100. USRABT:    DB    CR,LF,'+++ Aborting at user request.$'
  1101. FCBMSG:    DB    CR,LF,'+++ Bad source or destination FCB$'
  1102. BADDST:    DB    CR,LF,'+++ Bad characters in destination FCB$'
  1103. IGNMSG:    DB    CR,LF,'Some lines ignored - null or no key'
  1104.     DB    ' or too short.',CR,LF,'$'
  1105.  
  1106. PAGE:
  1107. PARM1:    DW    0        ; Pointer to first command line parameter
  1108. PARM2:    DW    0        ; Pointer to second command line parameter
  1109.  
  1110. DLMBUF:    DB    '<([{''"'    ; Left delimiters
  1111.     DB    '>)]}''"'    ; Matching right delimiters
  1112. DELLEN    EQU    $-DLMBUF    ; Length of buffer
  1113.  
  1114. ;;          'FILENAMETYP'
  1115. SRCFCB:    DB    0,'           ',0,0,0,0,0,0,0,0
  1116.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1117.  
  1118. ;;          'FILENAMETYP'
  1119. DSTFCB:    DB    0,'           ',0,0,0,0,0,0,0,0
  1120.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1121.  
  1122. NEWNAM:    DB    0,'        $$$',0,0,0,0,0,0,0,0
  1123.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1124.  
  1125.     NEXTPAGE
  1126. ARRAY    EQU    $        ; Base of key array
  1127. SRCMSG:    DB    CR,LF,LF,'Getting source file information.'
  1128.     DB    CR,LF,'$'
  1129. NULMSG:    DB    CR,LF,'+++ Null File - can''t read first record!$'
  1130. OPNERR:    DB    CR,LF,'+++ Error - can''t open input file!$'
  1131. OPNORR:    DB    CR,LF,'+++ Error - can''t open output file!$'
  1132. ;
  1133. ;
  1134. ; --------- NODE EXPLANATION -------------
  1135. ;
  1136. ; ND$PTR POINTS TO ITS ASSOCIATED NODE (ALL NODE-RELATIVE
  1137. ;    VALUES ARE THEN DECREMENTED BY 2)
  1138. ; ONLY THE ND$PTR WORDS ARE SWAPPED - THE OTHER 6 OR 8 BYTES
  1139. ;    ARE LEFT IN PLACE
  1140. ;
  1141. ; --------- NODE DEFINITIONS -------------
  1142. ;
  1143. ND$BAS    EQU    $        ; Base of node
  1144. ND$PTR    EQU    $-ND$BAS    ; Pointer to this node
  1145.     DW    0
  1146. ND$STR    EQU    $-ND$BAS    ; String offset
  1147.     DW    0
  1148. ND$REC    EQU    $-ND$BAS    ; Record number
  1149.     DW    0
  1150. ND$OFS    EQU    $-ND$BAS    ; Offset to current line
  1151.     DB    0
  1152. ND$LEN    EQU    $-ND$BAS    ; Length of current line
  1153.     DB    0
  1154.  
  1155.      IF    DEBUG
  1156. ND$LIN    EQU    $-ND$BAS    ; Input line number (0->n)
  1157.     DW    0
  1158. NODLEN    EQU    $-ND$BAS    ; Account for length
  1159.      ELSE
  1160. NODLEN    EQU    $-ND$BAS
  1161.      ENDIF
  1162. ;
  1163. ;
  1164. ; ------ END OF NODE DEFINITIONS ---------
  1165. ;
  1166. PAGE:
  1167. MENU:    DB    '                            '
  1168.     DB    'SRT.COM Version '
  1169. ;
  1170. ;
  1171. ; MENU & ORIGINAL TEXT FOLLOWS IN SOURCE LISTING
  1172. ;
  1173.     $-PRINT
  1174.     VERSION    THSVER,REVISE
  1175.     DB    CR,LF
  1176.     DB    'Usage: ',CR,LF
  1177.     DB    'A>SRT OUTFIL.TYP=INFIL.TYP [/switches] ',CR,LF
  1178.     DB    'Switches take one of two forms:',CR,LF
  1179.     DB    '                             /[offs'
  1180.     DB    'et],[keylen] ',CR,LF
  1181.     DB    '     where  offset and keylen are n'
  1182.     DB    'umeric  and represent  the  offset   from ',CR,LF
  1183.     DB    'the beginning of  the line and the '
  1184.     DB    'length of the  key, respectively; and ',CR,LF
  1185.     DB    '                /<skip string>[swit'
  1186.     DB    'ches][,keylen][switches] ',CR,LF
  1187.     DB    '     where  the "<" character can b'
  1188.     DB    'e any one of <,(,",'',{ or [.   A matching ',CR,LF
  1189.     DB    'right  delimiter is required as sho'
  1190.     DB    'wn in the example.   A switch  may  occur ',CR,LF
  1191.     DB    'after  the skip string either befor'
  1192.     DB    'e or after the keylen parameter.   "C" in ',CR,LF
  1193.     DB    'either position produces a contiguo'
  1194.     DB    'us skip_string request,  "K" says to save ',CR,LF
  1195.     DB    'the  keys as output,  and "O" sets '
  1196.     DB    'the offset value manually.   The  default ',CR,LF
  1197.     DB    'offset is the character following t'
  1198.     DB    'he last skip string character.  Delimiter ',CR,LF
  1199.     DB    'nesting  is  not allowed.   Note th'
  1200.     DB    'at in both cases the keylen  argument  is ',CR,LF
  1201.     DB    'optional and defaults to 22 decimal'
  1202.     DB    '. ',CR,LF
  1203.     DB    '     SRT also takes three special o'
  1204.     DB    'utput devices;  LST:, CON: and PUN:. They ',CR,LF
  1205.     DB    'perform  as in PIP and STAT.   Rese'
  1206.     DB    't 140h,  141h to disable source  display, ',CR,LF
  1207.     DB    'process  messages.   Set 142h for d'
  1208.     DB    'escending sort.   143h = switch character ',CR,LF
  1209.     DB    'storage  location.  Byte  144h begi'
  1210.     DB    'ns the clear screen  sequence,  which  is ',CR,LF
  1211.     DB    'stored in the format: db len,ch1,ch'
  1212.     DB    '2...ch8. ',CR,LF
  1213.     DB    '     To use lower case or other dif'
  1214.     DB    'ficult/impossible characters in the  skip ',CR,LF
  1215.     DB    'string,  use  the command format "S'
  1216.     DB    'RT <CMDLIN.FIL",  where the first line of ',CR,LF
  1217.     DB    'CMDLIN.FIL consists of the desired '
  1218.     DB    'command tail term. by carriage return.'
  1219.     DB    '$'
  1220. ;
  1221. ;             SRT.COM Version 1.2x
  1222. ; Usage:
  1223. ; A>SRT OUTFIL.TYP=INFIL.TYP [/switches]
  1224. ; Switches take one of two forms:
  1225. ;
  1226. ;              /[offset],[keylen]
  1227. ;
  1228. ; where offset and keylen are numeric and represent  the offset from
  1229. ; the beginning of the line and the length of the key, respectively;
  1230. ; and:
  1231. ;         /<skip string>[switches][,keylen][switches]
  1232. ;
  1233. ; where the "<" char. can be any one of <,(,",',{ or [.  A matching
  1234. ; right delimiter is required as shown in the example. A switch may
  1235. ; occur after  the skip-string, either    before or after  the keylen
  1236. ; parameter.  "C" in either position  produces    a contiguous  skip-
  1237. ; string request, "K" says to save the keys as output, and "O" sets
  1238. ; the offset value  manually.  The default offset  is the character
  1239. ; following  the last skip-string character.  Delimiter  nesting is
  1240. ; not allowed.    Note that in both cases  the keylen argument is op-
  1241. ; tional and defaults  to 22 decimal.  SRT also takes three special
  1242. ; output devices:  LST:, CON: and PUN:    They perform  as in PIP and
  1243. ; STAT.  Reset 140h, 141h to disable  source  display, process mes-
  1244. ; sages.   Set 142h for  descending sort.   143h = switch character
  1245. ; storage location.  Byte  144h begins    the clear  screen  sequence,
  1246. ; which is stored in the format:  DB LEN,CH1,CH2..CH8.    To use lower
  1247. ; case or other difficult/impossible  characters in the skip-string,
  1248. ; use the command format "SRT <CMDLIN.FIL",  where the first line of
  1249. ; CMDLIN.FIL consists of the desired command tail terminated by car-
  1250. ; riage return.
  1251. ;
  1252.     $+PRINT
  1253. PAGE:
  1254. ;SBTTL    GTTCM0- DEBUGGING FLAG PART OF GETCMD
  1255. ;==========================================================
  1256. ;
  1257.      IF    DEBUG
  1258. GTTCM0:    QWRITE    <SHOW THE KEYS?    >
  1259.     PAUSE
  1260.     CPI    'Y'
  1261.     JRNZ    GTTCM1
  1262.     LDA    SHWFLG
  1263.     SETB    BITKEY,A
  1264.     STA    SHWFLG
  1265.  
  1266. GTTCM1:    QWRITE    <SHOW THE SOURCE LINES?    >
  1267.     PAUSE
  1268.     CPI    'Y'
  1269.     JRNZ    GTTCM2
  1270.     LDA    SHWFLG
  1271.     SETB    BITLIN,A
  1272.     STA    SHWFLG
  1273.  
  1274. GTTCM2:    QWRITE    <SHOW THE SOURCE LINES ON INPUT? >
  1275.     PAUSE
  1276.     CPI    'Y'
  1277.     JRNZ    GTTCM3
  1278.     LDA    SHWFLG
  1279.     SETB    BITLN1,A
  1280.     STA    SHWFLG
  1281.  
  1282. GTTCM3:    CALL    QQCRLF        ; New line
  1283.     RET            ; To calling
  1284.      ENDIF
  1285.  
  1286. PAGE:
  1287. ;SBTTL    GETCMD- GET ALL PARAMETERS FROM COMMAND LINE
  1288. ;==========================================================
  1289. ;
  1290. GETCMD:    LXI    H,80H        ; Point to command line
  1291.     MOV    A,M
  1292.     ANA    A        ; Null command line?
  1293.     ERROR    MENU,Z        ; Split with menu if so
  1294.     MOV    B,A        ; No - move length into ctr
  1295.     INX    H        ; Point to first ascii
  1296.  
  1297. GETCM1:    MOV    A,M        ; Get a character
  1298.     CPI    SPACE        ; Space?
  1299.     JRNZ    GETCM2        ; No - branch for next test
  1300.     INX    H        ; Yes - point to next ascii
  1301.     DJNZ    GETCM1        ; - and loop for next
  1302.     ERROR    MENU        ; Nul buffer - split
  1303. ;
  1304. ;
  1305. ; -- NON-SPACE FOUND - GET OTHER POINTERS AS PRESENT/REQUIRED
  1306. ;
  1307. GETCM2:    SHLD    PARM1        ; Save pointer to it
  1308.     CPI    '<'        ; Redirection switch?
  1309.     JRNZ    GETCM2A        ; No - branch
  1310.     CALL    REGET        ; Yes - get input line from file
  1311.     TRAN    GETCMD        ; - and loop for fresh effort
  1312.  
  1313. GETCM2A:LDA    SWITCH        ; Get switch character
  1314.     MOV    C,A
  1315.  
  1316. GETCM3:    MOV    A,M        ; Get character
  1317.     CPI    '='        ; Found source fcb?
  1318.     JRNZ    GETCM4        ; No - branch
  1319.     SHLD    PARM2        ; Yes - save as second parameter
  1320.  
  1321. GETCM4:    CMP    C        ; Found switch character?
  1322.     JRZ    GETCM5        ; Yes - branch
  1323.     INX    H        ; - and point to next
  1324.     DJNZ    GETCM3        ; No - loop for next
  1325.     TRAN    GETC5A        ; End of buffer - branch
  1326. ;
  1327. ;
  1328. ; -- ALL PARAMETER BLOCKS FOUND AT THIS POINT
  1329. ;
  1330. GETCM5:    CALL    GETSWI        ; Get any switches
  1331.     MVI    M,0        ; Form delimiter for rightmost filespec
  1332.  
  1333. GETC5A:    LHLD    PARM2        ; Get potential source fcb
  1334.     MOV    A,H        ; Do we have one?
  1335.     ORA    L
  1336.     JRZ    GETCM6        ; Not here - branch
  1337.     MVI    M,0        ; Form delimiter (for parm1)
  1338.     INX    H        ; - point to filespec
  1339.     CALL    MAKSRC        ; - and make source fcb
  1340.     LHLD    PARM1        ; Point to destination filespec
  1341.     CALL    MAKDST        ; - and make destination fcb
  1342.     TRAN    GETCM9        ; Goto common exit point
  1343.  
  1344. GETCM6:    LHLD    PARM1        ; Get pointer
  1345.     CALL    MAKSRC        ; - and make fcb
  1346.  
  1347. GETCM9:     IF    DEBUG
  1348.     CALL    GTTCM0        ; Get debugging flags
  1349.      ENDIF
  1350.  
  1351.     LXI    D,SRCFCB
  1352.     LXI    H,DSTFCB
  1353.     MVI    B,12        ; Length of fcb
  1354.     CALL    CMPSTR        ; Compare them
  1355.     ERROR    '+++ Source & destination must be different',Z
  1356.     RET            ; To calling
  1357.  
  1358. PAGE:
  1359. ;SBTTL    REGET- GET COMMAND LINE FROM FILE @HL+1
  1360. ;==========================================================
  1361. ;
  1362. REGET:    INX    H        ; Point to filename
  1363.     XCHG
  1364.     FILFCB    ,5CH        ; - and make fcb
  1365.     OPEN    'I',5CH,REGRET    ; Get it?
  1366.     READS    5CH,81H,REGRET    ; Read first record offset by one
  1367.     LXI    H,81H        ; - and point to base of record
  1368.     LXI    B,80H        ; Length of buffer
  1369.     MVI    A,CR        ; Search character
  1370.     CCIR    0        ; Look for it
  1371.     JRNZ    REGRET        ; Split if no line
  1372.     DCX    H        ; Form null terminator
  1373.     MVI    M,0
  1374.     MVI    A,80H        ; Length of original counter
  1375.     SUB    C        ; Form length used
  1376.     STA    80H        ; - and save as length byte
  1377.     RET            ; To calling
  1378. REGRET:    ERROR    '+++ Null or missing command line file'
  1379.  
  1380. PAGE:
  1381. ;SBTTL    GETSWI- GET ALL SWITCHES
  1382. ;==========================================================
  1383. ;
  1384. ; ON ENTRANCE:
  1385. ;
  1386. ;    HL,B SET UP AS POINTER, COUNTER
  1387. ;     - WITH HL POINTING TO SWITCH CHARACTER
  1388. ; PDL:
  1389. ; GETSWI:
  1390. ; DO UNTIL (SWITCH CHARACTER FOUND)
  1391. ;   POINT TO NEXT CHARACTER
  1392. ;
  1393. ;   IF (END OF BUFFER FOUND) THEN
  1394. ;     GOTO [GETSW9]
  1395. ;   ENDIF
  1396. ;
  1397. ; ENDDO
  1398. ; GETSW1:
  1399. ; DO WHILE (WHITE SPACE FOUND)
  1400. ;   POINT TO NEXT CHARACTER
  1401. ;
  1402. ;   IF (END OF BUFFER FOUND) THEN
  1403. ;     GOTO [GETSW9]
  1404. ;   ENDIF
  1405. ;
  1406. ; ENDDO
  1407. ; GETSW5:
  1408. ;
  1409. ; IF (CHARACTER IS NUMERIC) THEN
  1410. ;   MAKE VALUE [MAKVAL]
  1411. ;   SAVE VALUE AS OFFSET VALUE
  1412. ;   SKIP OVER POTENTIAL COMMA CHARACTER
  1413. ;   MAKE VALUE [MAKVAL]
  1414.  
  1415. ;   IF (VALUE <> 0) THEN
  1416. ;     SAVE VALUE AS KEY LENGTH
  1417. ;   ENDIF
  1418. ;
  1419. ;   GOTO [GETSW9] TO EXIT
  1420. ; ELSE
  1421. ;   GET SKIP CHARACTERS [GETSKP]
  1422. ; ENDIF
  1423. ;
  1424. ; GETSW9:
  1425. ;   RETURN TO CALLING
  1426. ; END PDL:
  1427. ;
  1428. ; * FIND SWITCH CHARACTER
  1429. ;
  1430. GETSWI:    LDA    SWITCH        ; Get switch character
  1431.     MOV    C,A
  1432.     SAVE            ; Save all 8080 registers
  1433.     MOV    A,M        ; Get next character
  1434.     CMP    C        ; Switch character?
  1435.     JRZ    GETSW1        ; Yes - split
  1436.     INX    H        ; No - point to next
  1437.     DJNZ    GETSWI        ; - and loop
  1438.     TRAN    GETSW9        ; Eobuf - split altogether
  1439.  
  1440. GETSW1:    INX    H        ; Point to next
  1441.     DCR    B        ; Account for usage
  1442.     TRAN    Z,GETSW9    ; - and split if eobuf
  1443. ;
  1444. ;
  1445. ; * POINT PAST ANY WHITE SPACE
  1446. ;
  1447. GETSW2:    MOV    A,M        ; Get next character
  1448.     CPI    'K'        ; Save keys as output?
  1449.     CZ    SETKEY        ; Yes - set the switch
  1450.     CPI    'O'        ; Set if offset '0' request
  1451.     CZ    SETO
  1452.     CPI    SPACE        ; Space found?
  1453.     JRNZ    GETSW5        ; No - split
  1454.     INX    H        ; Yes - point to next
  1455.     DJNZ    GETSW2        ; - and loop for next char
  1456.     TRAN    GETSW9        ; Eobuf - split altogether
  1457. ;
  1458. ;
  1459. ; * IF FIRST PARAMETER IS NUMERIC, GET IT & TRY FOR SECOND
  1460. ;
  1461. GETSW5:    SUI    30H        ; Test for numeric range
  1462.     JM    GETSW8        ; Must be skip characters or illegal
  1463.     CPI    10        ; Test for numeric range
  1464.     JRNC    GETSW8        ; Must be skip characters or illegal
  1465.     CALL    MAKVAL        ; Get value of block
  1466.     MOV    A,E        ; Save as line offset
  1467.     STA    OFFSET
  1468.     MOV    A,B        ; End of buffer?
  1469.     ANA    A
  1470.     JRZ    GETSW9        ; Yes - split
  1471.     INX    H        ; No - point to next character
  1472.     DCR    B        ; - account for usage
  1473.     JRZ    GETSW9        ; - and branch on end of buffer
  1474.     CALL    MAKVAL        ; Make value if one is available
  1475.     MOV    A,E        ; Nul length?
  1476.     ANA    A
  1477.     JRZ    GETSW9        ; Yes - goto to common exit
  1478.     STA    KEYLEN        ; No - save key length
  1479.     JR    GETSW9        ; - then goto common exit
  1480. ;
  1481. ;
  1482. ; * ELSE TRY FOR SKIP_CHARACTER BUFFER
  1483. ;
  1484. GETSW8:    MOV    A,B        ; End of buffer? (this should be unnecessary)
  1485.     ANA    A
  1486.     JRZ    GETSW9        ; Yes - split
  1487.     CALL    MAKSKP        ; Get skip characters & length
  1488.  
  1489. GETSW9:    MOV    A,M        ; Get character
  1490.     CPI    'O'        ; Set if offset '0' request
  1491.     CZ    SETO
  1492.     CPI    'K'        ; Save key as output?
  1493.     CZ    SETKEY        ; Yes
  1494.     UNSAVE            ; Restore all 8080 registers
  1495.     RET            ; To calling
  1496.  
  1497. PAGE:
  1498. ;SBTTL    MAKVAL- MAKE BINARY VALUE FROM BUFFER @HL
  1499. ;==========================================================
  1500. ;
  1501. ; ON ENTRANCE:
  1502.  
  1503. ;    HL POINTS TO BUFFER
  1504. ;    B  = REMAINING LENGTH OF BUFFER
  1505. ; ON EXIT:
  1506. ;
  1507. ;    HL, B DEFINE REMAINING BUFFER & LENGTH
  1508. ;    VALUE IN DE
  1509. ;
  1510. MAKVAL:    MOV    A,B        ; End of buffer?
  1511.     ANA    A
  1512.     TRAN    Z,MAKVA9    ; Yes - split
  1513.     LXI    D,0        ; Init value
  1514.  
  1515. MAKVA1:    MOV    A,M        ; Get a character
  1516.     SUI    30H        ; Make it binary
  1517.     JM    MAKVA9        ; Split if out of range
  1518.     CPI    10        ; Test high side
  1519.     JRNC    MAKVA9        ; Split if out of range
  1520.     CALL    SUMMER        ; Sum the value in a to de
  1521.     INX    H        ; - and point to next
  1522.     DJNZ    MAKVA1        ; Loop through buffer
  1523.  
  1524. MAKVA9:    RET            ; To calling
  1525.  
  1526. ;PAGE
  1527. ;SBTTL    SUMMER- SUM 'A' TO DE - PRESERVE ALL OTHER REGISTERS
  1528. ;==========================================================
  1529. ;
  1530. SUMMER:    PUSH    H        ; Save pointer
  1531.     XCHG            ; *2
  1532.     DAD    H
  1533.     MOV    E,L        ; Replicate for later use
  1534.     MOV    D,H
  1535.     DAD    H        ; *4
  1536.     DAD    H        ; *8
  1537.     DAD    D        ; *10
  1538.     MOV    E,A        ; Form word from current 'a'
  1539.     MVI    D,0
  1540.     DAD    D        ; Sum new value
  1541.     XCHG            ; Restore registers
  1542.     POP    H
  1543.     RET            ; To calling
  1544.  
  1545. PAGE:
  1546. ;SBTTL    MAKSRC- MAKE SOURCE FCB FROM FILESPEC AT HL
  1547. ;==========================================================
  1548. ;
  1549. ; ON ENTRANCE:
  1550. ;
  1551. ;    HL POINTS TO SOURCE FILESPEC
  1552. ; ON EXIT:
  1553. ;
  1554. ;    SRCFCB MADE & VALIDATED OR FATAL ERROR DECLARED
  1555. ;
  1556. MAKSRC:    LXI    D,SRCFCB
  1557.     CALL    MAKFCB
  1558.     VALIDATE SRCFCB,SRCERR    ; Make sure valid fcb
  1559.     RET            ; To calling
  1560.  
  1561. SRCERR:    ERROR    '+++ Bad characters in source FCB'
  1562.  
  1563. ;PAGE
  1564. ;SBTTL    MAKDST- MAKE DESTINATION FCB FROM @HL
  1565. ;==========================================================
  1566. ;
  1567. ; ON ENTRANCE:
  1568. ;
  1569. ;    HL POINTS TO DESTINATION FCB
  1570. ; PROCESSING:
  1571. ;
  1572. ;    RECOGNISE CON:,PUN:,LST: AS SPECIAL CASES (ONLY THE
  1573. ;        - FIRST CHARACTER NEEDS TO BE TESTED)
  1574. ; ON EXIT:
  1575. ;
  1576. ;    DESTINATION FCB SET UP OR OUTPUT BYTE = OUTPUT DEVICE
  1577. ;     - OR FATAL ERROR DECLARED
  1578. ;
  1579. MAKDST:    SAVE
  1580.  
  1581. MAKDS1:    PUSHS    D,H
  1582.     LXI    D,3        ; Point to potential ':'
  1583.     DAD    D        ; - in HL
  1584.     MOV    A,M        ; Found special case?
  1585.     CPI    ':'
  1586.     POPS    H,D        ; (restore registers)
  1587.     TRAN    NZ,MAKDS2    ; No - branch
  1588.     MOV    A,M        ; Yes - get first character
  1589.     CPI    'C'        ; Console request?
  1590.     TRAN    Z,MAKCON    ; Yes - set switch
  1591.     CPI    'P'        ; Punch request?
  1592.     TRAN    Z,MAKPUN    ; Yes - set switch
  1593.     CPI    'L'        ; List request?
  1594.     TRAN    Z,MAKLST    ; Yes  - set switch
  1595.     ERROR    '+++ Special destination error'    ; No - report error & abort
  1596.  
  1597. MAKDS2:    LXI    D,DSTFCB    ; Point to destination fcb
  1598.     CALL    MAKFCB        ; Make fcb from buffer @hl
  1599.     VALIDATE DSTFCB,DSTERR    ; Make sure valid fcb
  1600.     TRAN    MAKDS9        ; - and branch to common exit
  1601. ;
  1602. ;
  1603. ; -- NOTE THAT MAKCON IS ONLY INCLUDED FOR COMPLETENESS, AS THE CONSOLE
  1604. ;    ON SWITCH IS SET BY DEFAULT AT ASSEMBLY TIME.
  1605. ;
  1606. MAKCON:    LDA    DSTFLG        ; Get current sense of switch
  1607.     SETB    CON,A        ; Set con: output flag
  1608.     JR    MAKCMN        ; - and branch to common code
  1609.  
  1610. MAKPUN:    LDA    DSTFLG        ; Get current sense of switch
  1611.     SETB    PUNOUT,A    ; Set pun: output flag
  1612.     JR    MAKCMN        ; - and branch to common code
  1613.  
  1614. MAKLST:    LDA    DSTFLG        ; Get current sense of switch
  1615.     SETB    LSTOUT,A    ; Set lst: output flag
  1616.  
  1617. MAKCMN:    STA    DSTFLG        ; Save output device switch
  1618.     MVI    A,SPACE        ; \
  1619.     STA    DSTFCB+1    ; / - and ensure bad file name
  1620.  
  1621. MAKDS9:    UNSAVE            ; Restore all 8080 registers
  1622.     RET            ; To calling
  1623.  
  1624. DSTERR:    ERROR    BADDST
  1625.  
  1626. PAGE:
  1627. ;SBTTL    MAKSKP- GET SKIP CHARACTERS FROM COMMAND LINE
  1628. ;==========================================================
  1629. ;
  1630. ; ON ENTRANCE:
  1631. ;
  1632. ;    HL POINTS TO COMMAND LINE
  1633. ;    B  = REMAINING LENGTH
  1634. ; ON EXIT:
  1635. ;
  1636. ;    SKIP CHARACTERS HAVE BEEN PLACED IN SKIP STRING BUFFER
  1637. ;    HL, B DEFINE REMAINING BUFFER & LENGTH
  1638. ;
  1639. MAKSKP:    XCHG            ; Set up for us
  1640.  
  1641. MAKSK1:    PUSH    B        ; Save counter
  1642.     LXI    B,DELLEN/2    ; Look at left delimiters
  1643.     LDAX    D        ; Get a character
  1644.     LXI    H,DLMBUF    ; Point to delimiter buffer
  1645.     CCIR            ; Match on current char?
  1646.     JRZ    MAKSK5        ; Yes - branch
  1647.     POP    B        ; No - try again
  1648.     INX    D        ; Point to next source
  1649.     DJNZ    MAKSK1        ; - and loop for next try
  1650.     XCHG            ; Restore buffer pointer
  1651.     TRAN    MAKSK9        ; - and goto common exit
  1652. ;
  1653. ;
  1654. ; -- AT THIS POINT WE HAVE A MATCH ON THE LEFT DELIMITER
  1655. ; -- NOW MOVE CHARACTERS UNTIL MATCHING RIGHT DEL FOUND.
  1656. ;
  1657. ; --     IF (END OF STRING FOUND BEFORE END OF COMMAND BUFFER) THEN
  1658. ; --      TRY FOR KEY LENGTH REQUEST
  1659. ; --     ENDIF
  1660. ;
  1661. MAKSK5:    POP    B        ; Restore counter register
  1662.     PUSH    D        ; Save command line pointer
  1663.     LXI    D,(DELLEN/2)-1    ; Offset to matching right delimiter
  1664.     DAD    D        ; Point to it
  1665.     MOV    C,M        ; - and get it for us
  1666.     POP    H        ; Restore command line pointer
  1667.     INX    H        ; Point past left delimiter
  1668.     DCR    B        ; \  account for usage
  1669.     MOV    A,B
  1670.     ANA    A        ; | end of command line buffer?
  1671.     JRZ    MAKSKZ        ; /  yes - split
  1672.     LXI    D,SKPSTR    ; No - point to skip string buffer
  1673.  
  1674. MAKSK6:    MOV    A,M        ; End of buffer reached?
  1675.     CMP    C
  1676.     JRZ    MAKSK9        ; Yes - split
  1677.     STAX    D        ; No - save it
  1678.     INX    H        ; Point to next source, dest
  1679.     INX    D
  1680.     DJNZ    MAKSK6        ; - and loop for next
  1681.  
  1682. MAKSK9:    XCHG            ; Form NUL terminator in SKPSTR
  1683.     MVI    M,0
  1684.     XCHG            ; Restore registers
  1685.     PUSHS    D,H        ; Save registers
  1686.     LXI    H,-SKPSTR    ; - and form length byte
  1687.     DAD    D        ; - in 'l'
  1688.     MOV    A,L        ; - and save it in length byte
  1689.     STA    SKPLEN
  1690.     POPS    H,D        ; Restore registers
  1691.     MOV    A,B        ; End of buffer reached?
  1692.     ANA    A
  1693.     JRZ    MAKSKZ        ; Yes - split altogether
  1694.     INX    H        ; No - point to next source
  1695.     DCR    B
  1696.     MOV    A,B        ; End of buffer reached?
  1697.     ANA    A
  1698.     JRZ    MAKSKZ        ; Yes - split altogether
  1699.  
  1700. MAKSKA:    MOV    A,M        ; Get a character
  1701.     CPI    ','        ; Length request?
  1702.     JRZ    MAKSKD        ; Yes - branch
  1703.     CPI    'O'        ; Set if offset request
  1704.     CZ    SETO
  1705.     CPI    'K'        ; Save key as output?
  1706.     CZ    SETKEY        ; Yes
  1707.     CPI    'C'        ; Contiguous request?
  1708.     JRNZ    MAKSKB        ; No - branch
  1709.     STA    CTGSWI        ; Yes - set switch
  1710.  
  1711. MAKSKB:    INX    H        ; Point to next
  1712.     DJNZ    MAKSKA        ; - and loop for next
  1713.     JR    MAKSKZ        ; - bail out if not found
  1714.  
  1715. MAKSKD:    INX    H        ; Found ',' - point to next source
  1716.     DCR    B
  1717.     MOV    A,B        ; End of buffer reached?
  1718.     ANA    A
  1719.     JRZ    MAKSKZ        ; Yes - split altogether
  1720.     CALL    MAKVAL        ; Determine the key length value
  1721.     MOV    A,E        ; Nul value?
  1722.     ANA    A
  1723.     JRZ    MAKSKE        ; Yes - branch
  1724.     STA    KEYLEN        ; No - save it
  1725.  
  1726. MAKSKE:    MOV    A,B        ; End of buffer reached?
  1727.     ANA    A
  1728.     JRZ    MAKSKZ        ; Yes - split altogether
  1729.  
  1730. MAKSKF:    MOV    A,M        ; Get next character
  1731.     CPI    'O'        ; Set if offset '0' request
  1732.     CZ    SETO
  1733.     CPI    'K'        ; Save key as output?
  1734.     CZ    SETKEY        ; Yes
  1735.     CPI    'C'        ; Contiguous request?
  1736.     JRNZ    MAKSKG        ; No - branch
  1737.     STA    CTGSWI        ; Yes - set switch
  1738.  
  1739. MAKSKG:    INX    H        ; Point to next
  1740.     DJNZ    MAKSKA        ; - and loop for next
  1741.  
  1742. MAKSKZ:    RET            ; To calling
  1743.  
  1744. ;SBTTL    SETKEY-, SETO- SET KEY=OUTPUT, SET NON-DEFAULT OFFSET
  1745. ;==========================================================
  1746. ;
  1747. SETKEY:    PUSH    H        ; Save register
  1748.     LXI    H,SHWFLG    ; Point to flag
  1749.     SETB    BITK80,M    ; Set the bit
  1750.     POP    H        ; Restore register
  1751.     RET            ; To calling
  1752.  
  1753. SETO:    PUSH    H        ; Save register
  1754.     LXI    H,SHWFLG    ; Point to flag
  1755.     SETB    BITK06,M    ; Set the bit
  1756.     POP    H        ; Restore register
  1757.  
  1758.     PUSHS    B,H        ; Save registers
  1759.     INX    H        ; Test for end of buffer
  1760.     DCR    B
  1761.     JRZ    SETO9        ; Branch if eobuf
  1762.     CALL    MAKVAL        ; - else get the value
  1763.     MOV    A,E        ; - and save it
  1764.     STA    OFFSET
  1765.  
  1766. SETO9:    POPS    H,B        ; Restore registers
  1767.     RET            ; To calling
  1768.  
  1769. PAGE:
  1770. ;SBTTL    MAKFCB- MAKE FCB FROM SOURCE @ HL TO DST @ DE
  1771. ;==========================================================
  1772. ;
  1773. MAKFCB:    PUSHS    B,D,H,D,H
  1774.     LXI    D,INTBUF+1    ; Point to dummy buffer
  1775.     LXI    B,16        ; Generous length
  1776.     LDIR    0        ; Move it in
  1777.     POPS    D,H        ; Reverse registers, too...
  1778.     FILFCB    INTBUF+1    ; Make a valid fcb for us
  1779.     ERROR    FCBMSG,C    ; Split on error
  1780.     POPS    H,D,B        ; Pass flag info to calling
  1781.     RET            ; To calling
  1782.  
  1783. PAGE:
  1784. ;SBTTL    OPNFIL- OPEN INPUT & OUTPUT FILES
  1785. ;==========================================================
  1786. ;
  1787. OPNFIL:    OPEN    'I',SRCFCB,OPNFIX ; Ptr set at assy time
  1788.     LDA    DSTFCB+1    ; Valid FCB?
  1789.     CPI    SPACE
  1790.     TRAN    Z,OPNFI9    ; No - split
  1791.     LXI    H,OPNORR    ; Set error message pointer
  1792.     SHLD    OPNPTR
  1793.     OPEN    'I',DSTFCB    ; Check for existing file
  1794.     TRAN    C,OPNFI8    ; No file - branch
  1795.     PRINTM    OH$OH        ; Tell user file exists
  1796.     PAUSE            ; - and get response
  1797.     ANI    UPPER
  1798.     CPI    'Y'        ; Ok to trash it?
  1799.     ERROR    USRABT,NZ    ; No - split
  1800.  
  1801. OPNFI8:    OPEN    'O',DSTFCB,OPNFIX ; Yes - open the file
  1802. OPNFI9:    RET            ; To calling
  1803.  
  1804. OPNFIX:    ERROR    (OPNPTR)    ; Output appropriate error message
  1805. ??XX??    EQU    $
  1806. ;SBTTL    END OF TASK
  1807.  
  1808.  
  1809.     END    100H
  1810.