home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol127 / comm723c.aqm / COMM723C.ASM
Assembly Source File  |  1985-02-09  |  24KB  |  1,083 lines
  1. ; (comm723c.asm)
  2.  
  3. ; command line called by main menu in 'header' file
  4.  
  5. C$LINE    MVI    A,TRUE        ;automatic transfer to xprt mode
  6.     STA    XPRFLG
  7. XPRT    CALL    ILPRT
  8.     DB    CR,ESC,ETEOP,ESC,BDIM,0 ; <cr>, erase-to-end-of-page.
  9.  
  10.      IF    RTC AND (CW OR SS1) AND (NOT TIME$ONLY)
  11.     CALL    TIMEDAY
  12.      ENDIF            ;rtc and (cw or ss1) and (not time$only)
  13.  
  14.      IF    RTC AND (CW OR SS1) AND TIME$ONLY
  15.     CALL    TIME
  16.      ENDIF            ;rtc and (cw or ss1) and time$only
  17.  
  18.     MVI    C,INQDISK    ;get default drive
  19.     CALL    BDOS        ;store as prevailing..
  20.     STA    CMD$DR        ;..command line drive.
  21.     ADI    'A'        ;make ascii and..
  22.     CALL    TYPE        ;..show on crt.
  23.     MVI    E,GET        ;set to get..
  24.     MVI    C,SGUSER    ;..current user area..
  25.     CALL    BDOS        ;..and..
  26.     STA    C$U$A        ;..store.
  27.     ORA    A        ;if user area 0 then..
  28.     JZ    XPRT2        ;..don't process.
  29.     CPI    10        ;user <10?
  30.     JC    XPRT1        ;no, then print now.
  31.     SUI    10        ;if not, subtract 10 from it..
  32.     PUSH    PSW        ;..and save.
  33.     MVI    A,'1'        ;output 10's digit..
  34.     CALL    TYPE        ;..locally.
  35.     POP    PSW        ;get 1's digit back and..
  36. XPRT1    ADI    '0'        ;..convert to ascii then..
  37.     CALL    TYPE        ;..finally show it.
  38. XPRT2    CALL    ILPRT
  39.     DB    '>Command: ',ESC,EDIM,0        ;default drive prompt
  40. GETCMD    LXI    D,CMDBUF     ;point to storage for..
  41.     CALL    INBUF        ;..command entry.
  42.     LDA    CMDBUF+3    ;see if drive/user select
  43.     CPI    ':'        ;yes, then..
  44.     JZ    SETDRV        ;..change, else..
  45.     LXI    D,CMDBUF+2     ;..point to other command.
  46.     CALL    ILCOMP
  47.     DB    'SAP',0
  48.     JNC    S$A$P        ;sort and pack directory of selected drive
  49.     CALL    ILCOMP
  50.     DB    'SEL',0
  51.     JNC    SETDPS        ;select transmission characteristics
  52.     CALL    ILCOMP
  53.     DB    'CPM',0
  54.     JNC    PREEXIT        ;leave modem, test line connection first
  55.     CALL    ILCOMP
  56.     DB    'DIR',0
  57.     JNC    DIR        ;display directory and reset disk system
  58.     CALL    ILCOMP
  59.     DB    'WRT',0
  60.     JNC    WRTFILE        ;write-to-ram or..
  61.     CALL    ILCOMP
  62.     DB    'DEL',0
  63.     JNC    DELNEWF        ;..delete newly saved file.
  64.     CALL    ILCOMP
  65.     DB    'ERA',0
  66.     JNC    ERASEF        ;erase or..
  67.  
  68.      IF    UTL
  69.     CALL    ILCOMP
  70.     DB    'UTL',0
  71.     JNC    DISK7
  72.      ENDIF            ; 'utl'
  73.  
  74.      IF    VUE
  75.     CALL    ILCOMP
  76.     DB    'VUE',0
  77.     JNC    VIEWFIL        ;..type-to-console declared file(s).
  78.      ENDIF            ; 'vue'
  79.  
  80.      IF    PMMI
  81.     CALL    ILCOMP        ;de-pair set from 1st ilcomp call
  82.     DB    'DSC',0
  83.     JNC    DISCON1
  84.     CALL    ILCOMP
  85.     DB    'CAL',0
  86.     JC    NEXTOPT
  87.     CALL    ILPRT
  88.     DB    CR,ESC,ETEOP,0
  89.     MVI    A,' '        ;blank-out 'l' of 'cal' and..
  90.     STA    CMDBUF+4    ;..fool cmdbuf to..
  91.     JMP    DOOPT        ;..look at option for dial.
  92.      ENDIF            ;pmmi
  93.  
  94. NEXTOPT    LDA    CMDBUF+1
  95.     ORA    A        ;ignore if null from.. 
  96.     JZ    MENU        ;..only <return> entered.
  97.     LDA    CMDBUF+2
  98.     LXI    H,COMPLIST    ;compares list pointed to by hl-pair to char..
  99.     CALL    COMPARE        ;..in a-reg.  (validate primary option)
  100.     JC    BADCMD        ;carry set --> no match, show bad command.
  101. DOOPT    CALL    SETFCB        ;setup cp/m-convention cmd line at fcb
  102.     CALL    PROCOPT        ;..process options.  then..
  103.     JMP    RESTART        ;..go to beginning-of-program routine.
  104.  
  105. ; 'setdrv' selects requested drive/user area with full entry error trapping
  106.  
  107. SETDRV     LDA    CMDBUF+2
  108.     CPI    'A'        ;don't allow less than 'a'..
  109.     JC    BADCMD
  110.     CPI    (MAXDR)+1    ;..or more than 'maxdr'.
  111.     JNC    BADCMD
  112.     SUI    'A'        ;convert a: to 0
  113.     MOV    E,A
  114.     MVI    C,LOGIN        ;login new drive
  115.     CALL    BDOS
  116.     LDA    CMDBUF+5
  117.     CPI    '0'        ;no valid user area request..
  118.     JC    MENU        ;..then back to cmd line.
  119.     CPI    '9'+1
  120.     JNC    BADCMD        ;error, not a user area.
  121.     SUI    30H        ;convert to binary and..
  122.     CPI    1        ;..test if 10's digit.
  123.     JNZ    SETUSER        ;no, then set user area now.
  124.     LDA    CMDBUF+6    ;anything else there?
  125.     CPI    '0'        ;test for 1's digit
  126.     JC    SETUONE
  127.     CPI    '5'+1        ;if user area >15..
  128.     JNC    BADCMD        ;..go cmd line.
  129.     SUI    30H-10        ;make 1 --> 11, 2 --> 12, etc.
  130.     JMP    SETEXIT
  131.  
  132. SETUONE    MVI    A,1        ;set to user area one
  133. SETUSER    MOV    B,A
  134.     LDA    CMDBUF+6
  135.     CPI    '0'        ;if >19 user area, go menu.
  136.     JNC    BADCMD
  137.     MOV    A,B
  138. SETEXIT    STA    C$U$A        ;store as user area and..
  139.     CALL    SET$USR        ;..establish as current.
  140.     JMP    MENU
  141.  
  142. ; d e l
  143.  
  144. ; delete file ram-saved in terminal mode
  145.  
  146. DELNEWF    CALL    OKFILE        ;file open?
  147.     LXI    D,FCB3
  148.     MVI    C,ERASE        ;erase file ram-saved..
  149.     CALL    BDOSRET        ;..in terminal mode.
  150.     JMP    LEAVE
  151.  
  152. ; w r t
  153.  
  154. ; write-to-disk file saved in terminal mode
  155.  
  156. WRTFILE    CALL    OKFILE        ;file open?
  157.     CALL    RAMDISK        ;get # of records indicated by hl-pair..
  158.     CALL    CLOSE3        ;..then write-to-disk and close file.
  159.  
  160. ; default setting of file-save flag registers
  161.  
  162. LEAVE    MVI    A,TRUE
  163.     STA    NFILFLG        ;true indicates no-file being saved..
  164.     CMA
  165.     STA    ALERTFG        ;..but false is required here..
  166.     STA    SAVEFLG        ;..and here for no-save.
  167.     LXI    H,FCB3
  168.     CALL    INITFCB        ; (now written-file can't be 'del'ed)
  169.     CALL    ILPRT
  170.     DB    CR,ESC,ETEOP,'---> Operation completed ',0
  171.     JMP    MSGREAD
  172.  
  173. ; file-open check and no-file-presently-open announcement
  174.  
  175. OKFILE    LDA    NFILFLG        ;make doubly sure..
  176.     ORA    A
  177.     JNZ    NOFILE
  178.     LDA    FCB3+1        ;..a file is open.
  179.     CPI    ' '
  180.     RNZ
  181. NOFILE    CALL    ILPRT
  182.     DB    CR,ESC,ETEOP,'++ No file presently open ++ ',0
  183.     JMP    MSGREAD
  184.  
  185. ; e r a
  186.  
  187. ; erase cp/m file(s) -- wildcard (*.ft) filenames permitted
  188.  
  189. ERASEF    CALL    VERIFY        ;does file exist?
  190.     JNZ    ERAFILE     ;this is why we're here, do it.
  191. REDO    CALL    ILPRT
  192.     DB    CR,ESC,ETEOP,'++ Unable to locate file -- check '
  193.     DB    'spelling ++ ',0
  194.     JMP    MSGREAD        ;get delay to read message, go menu.
  195.  
  196. ERAFILE CALL    NOASK        ;erase routine for filename at 'fcb'
  197.     CALL    ILPRT
  198.     DB    CR,ESC,ETEOP,'---> File(s) erased ',0
  199. MSGREAD    MVI    B,20        ; 2-second time..
  200.     CALL    TIMER        ;..to read console message.
  201.     JMP    MENU
  202.  
  203. ; v u e
  204. ; type file to console with pagination set to 'lps' -- single-line scroll
  205. ; using <space> bar , <ctrl-x> to cancel, any other key to page screen.
  206.  
  207.      IF    VUE
  208. VIEWFIL    CALL    VERIFY
  209.     JZ    REDO
  210.     CALL    ILPRT
  211.     DB    ESC,BDIM,'<CTRL-X> cancels, <space> turns up one line, '
  212.     DB    'other keys page screen.',ESC,EDIM,CR,LF,LF,0
  213.     MVI    A,1        ;initialize..
  214.     STA    LPSCNT        ;..lines-per-screen counter.
  215.     LXI    D,FCB
  216.     MVI    C,OPEN
  217.     CALL    BDOS
  218.     LXI    D,TBUF
  219.     MVI    C,SETDMA
  220.     CALL    BDOS
  221. READF    LXI    D,FCB
  222.     MVI    C,READ        ;read 128 bytes
  223.     CALL    BDOS    
  224.     ORA    A        ;good read?
  225.     JNZ    MENU        ;to cmd line if 'eof' or bad read
  226.     MVI    B,80H        ;ready to read..
  227.     LXI    H,TBUF        ;..128-byte record from 'tbuf'.
  228. READLP    MOV    A,M        ;get character from memory
  229.     CPI    EOFCHAR        ;don't send to console
  230. EXITVUE    CZ    CRLF        ;exit with fresh line
  231.     JZ    MENU
  232.     CALL    TYPEQ        ;display on console
  233.     CPI    LF        ;at end of line?
  234.     CZ    PAGER        ;yes, test if at # of lines limit.
  235.     INX    H
  236.     DCR    B
  237.     JNZ    READLP        ;loop for 128 bytes or 'eofchar'
  238.     JMP    READF        ;get more
  239.  
  240. PAGER    LDA    LPSCNT        ;is counter..
  241.     INR    A        ;..at..
  242.     STA    LPSCNT        ;..limit..
  243.     CPI    LPS        ;..of lines-per-screen?
  244.     RC            ;no, return.
  245.     XRA    A        ;yes, initialize..
  246.     STA    LPSCNT        ;..for next screen full.
  247.     CALL    ILPRT
  248.     DB    ESC,BDIM,'  [more...]',CR,0    ;show msg line
  249.     CALL    KEYIN        ;wait for keyboard input
  250.     CPI    CAN        ;cancel?
  251.     PUSH    PSW
  252.     CALL    ILPRT
  253.     DB    ESC,ETEOP,ESC,EDIM,0        ;clear msg line
  254.     POP    PSW
  255.     JZ    EXITVUE        ;yes, else..
  256.     CPI    ' '        ;..see if <space> bar.
  257.     RNZ            ;if not, return for another page.
  258.     MVI    A,LPS-1        ;if so, set up for single-line..
  259.     STA    LPSCNT        ;..scroll and..
  260.     RET            ;..return for one more line.
  261.      ENDIF            ; 'vue'
  262.  
  263. ; 'cmdbuf' set up for file procesing -- return with zero flag set if file
  264. ; not found.  jump to 'redo' if filename not entered.
  265.  
  266. VERIFY    CALL    SETFCB        ;setup cp/m-convention cmd line at fcb
  267.     CALL    MOVEFCB        ;move fcb+16 to fcb
  268.     LDA    FCB+1
  269.     CPI    ' '
  270.     JZ    REDO        ;redo, if desired.
  271.     LXI    D,FCB
  272.     MVI    C,SRCHF
  273.     CALL    BDOS
  274.     INR    A        ; 0ffh --> 0 means file not found
  275.     RET            ; ret with not-zero if found
  276.  
  277. ; d s c
  278.  
  279. ; disconnect telephone line with announcement -- check to protect
  280. ; for open save-file
  281.  
  282.      IF    PMMI
  283. DISCON1    CALL    DISCONN        ;if pmmi, disconnect..
  284.     CALL    ILPRT        ;..and display message.
  285.     DB    CR,ESC,ETEOP,'---> Disconnected ',0
  286.     MVI    B,10
  287.     CALL    TIMER        ;get time to read message
  288.      ENDIF            ;pmmi
  289.  
  290. ALERT    XRA    A        ;turn off direct i/o
  291.     STA    DTYPE
  292.     LDA    LISTFLG        ;is printer on?
  293.     ORA    A    
  294.     JNZ    LETFGBE        ;no, let printer flags be.
  295.     MVI    A,TRUE        ;turn printer off and..
  296.     STA    LISTFLG        ;..set flag to turn back on..
  297.     STA    LSTRETF        ;..if re-entering terminal mode.
  298. LETFGBE    LDA    ALERTFG        ;check if save-file is active (i.e., if..
  299.     ORA    A        ;..<ctrl-y> has been used at least once).
  300.     JZ    MENU        ;reset options here or..
  301. FILOPEN    CALL    ILPRT        ;announce file still open
  302.     DB    CR,LF,'++ A file is open -- use T-WRT-DEL-DIR-M '
  303.     DB    'before other commands ++',BELL,CR,LF,0
  304.     JMP    MENU        ;..here.
  305.  
  306. ; bad entry message
  307.  
  308. BADCMD    CALL    ILPRTQ
  309.     DB    CR,ESC,ETEOP,'++ Invalid command ++ ',BELL,0
  310.     JMP    MSGREAD
  311.  
  312. ; list compare
  313.  
  314. COMPARE    MOV    B,M        ;compares a-reg with list..
  315. COMPLP    INX    H        ;..addressed by hl-pair.  first character..
  316.     CMP    M        ;..of list must be number of elements..
  317.     RZ            ;..being compared.  returns with..
  318.     DCR    B        ;..carry set if a-reg does not..
  319.     JNZ    COMPLP        ;..match a character in list.
  320.     STC
  321.     RET
  322.  
  323. COMPLIST DB 5, 'S', 'R', 'T', 'E', 'M'    ;address in hl-pair
  324.  
  325. ; s e l
  326.  
  327. ; set data, parity, and stop (dps) bits.  select full or half-duplex and
  328. ; filtering of control codes from received data in terminal mode.
  329.  
  330. SETDPS    CALL    ILPRT
  331.     DW    CLS              ;clear screen
  332.     DB    ESC,BDIM,LF,LF,LF,LF,LF,LF ;lf down
  333.     DB    '   Transmission Characteristics -- <RETURN> for default '
  334.     DB    'settings',CR,LF,LF,ESC,EDIM,0
  335.      IF    PMMI
  336. DATABIT    CALL    ILPRT
  337.     DB    CR,'    How many data bits (5,6,7,8)? ',0
  338.     CALL    KEYIN
  339.     CPI    CR            ;default requested so retain current..
  340.     JNZ    DATAB            ;..then show menu & cmd-line prompt.
  341.     MVI    A,'8'
  342. ;
  343. DATAB    CPI    '5'
  344.     MVI    B,M5$DATA        ; 5-data-bits mask
  345.     JZ    EQUAL
  346.     CPI    '6'
  347.     MVI    B,M6DATA
  348.     JZ    EQUAL
  349.     CPI    '7'
  350.     MVI    B,M7DATA
  351.     JZ    EQUAL
  352.     MVI    B,M8DATA
  353.     CPI    '8'
  354.     JNZ    DATABIT
  355.     CALL    TYPE            ;print character
  356. EQUAL    MOV    A,B            ;put request into a-reg
  357.     STA    BITTEMP            ;store parity request
  358.     MVI    A,LF
  359.     CALL    TYPE
  360. PARLP    CALL    ILPRT
  361.     DB    CR,'  Parity (O>dd, E>ven, or N>one)? ',0
  362.     CALL    KEYIN
  363.     CALL    UCASE
  364.     CPI    CR
  365.     JNZ    PARLP1
  366.     MVI    A,'N'
  367. PARLP1    CPI    'O'
  368.     MVI    B,MOPAR            ;odd parity..
  369.     JZ    STOPBIT
  370.     CPI    'E'
  371.     MVI    B,MEPAR            ;..even..
  372.     JZ    STOPBIT
  373.     CPI    'N'
  374.     MVI    B,MNPAR            ;..or none.
  375.     JNZ    PARLP
  376. STOPBIT    CALL    TYPE            ;print character
  377.     LDA    BITTEMP
  378.     ORA    B            ;add parity to data bits
  379.     STA    BITTEMP
  380.     MVI    A,LF
  381.     CALL    TYPE
  382. TSBLP    CALL    ILPRT
  383.     DB    CR,'              Stop bits (1 or 2)? ',0
  384.     CALL    KEYIN
  385.     CPI    CR
  386.     JNZ    TSBLP1
  387.     MVI    A,'1'
  388. TSBLP1    CPI    '1'
  389.     MVI    B,M1STOP        ; 1 stop bit
  390.     JZ    SETBITS
  391.     CPI    '2'
  392.     MVI    B,M2STOP        ; 2 stop bits
  393.     JNZ    TSBLP
  394. SETBITS    CALL    TYPE            ; print character
  395.     LDA    BITTEMP
  396.     ORA    B            ;add stop to data and parity bits
  397.     STA    ORIGMOD            ;store full format here, then..
  398.     INR    A            ;..convert to answer mode and..
  399.     STA    ANSWMOD            ;..store again.  then..
  400.     MVI    A,LF
  401.     CALL    TYPE
  402.      ENDIF                ;pmmi
  403.  
  404. F$H$LP    CALL    ILPRT
  405.     DB    CR,'           F>ull or H>alf-duplex? ',0
  406.     CALL    KEYIN
  407.     CALL    UCASE
  408.     CPI    CR
  409.     JNZ    F$H$LP1
  410.     MVI    A,'F'
  411. F$H$LP1    CPI    'F'
  412.     JZ    FUL$DUP
  413.     CPI    'H'
  414.     JNZ    F$H$LP            ;neither, so query again.
  415.     CALL    TYPE            ;print character
  416.     ORI    TRUE
  417.     STA    HALFDUP
  418.     JMP    FILCTRL
  419.  
  420. FUL$DUP    CALL    TYPE            ;print character
  421.     XRA    A            ; 'full' is default
  422.     STA    HALFDUP
  423.  
  424. FILCTRL    MVI    A,LF
  425.     CALL    TYPE
  426. FIL$LP    CALL    ILPRT
  427.     DB    CR,'Filter out control codes?  (Y/N): ',0
  428.     CALL    KEYIN
  429.     CALL    UCASE
  430.     CPI    CR
  431.     JNZ    FIL$LQ
  432.     MVI    A,'N'
  433. FIL$LQ    CPI    'N'
  434.     JZ    FIL$NO
  435.     CPI    'Y'
  436.     JNZ    FIL$LP            ;query again
  437.     CALL    TYPE            ;print character
  438.     ORI    TRUE
  439.     STA    FILBYTE
  440.     JMP    DIRCTIO
  441.  
  442. FIL$NO    CALL    TYPE            ;print character
  443.     XRA    A            ;no filtering is default
  444.     STA    FILBYTE
  445.  
  446. DIRCTIO    MVI    A,LF            ;go to next line
  447.     CALL    TYPE
  448. DCTLP    CALL    ILPRT
  449.     DB    CR,' Use direct I/O in terminal mode? ',0
  450.     CALL    KEYIN
  451.     CALL    UCASE
  452.     CPI    CR            ;default= no
  453.     JNZ    DCT$IO
  454.     MVI    A,'N'
  455. DCT$IO    CPI    'N'            ;no
  456.     JZ    DCT$NO
  457.     CPI    'Y'            ;no
  458.     JNZ    DCTLP
  459.     CALL    TYPE            ;print character
  460.     ORI    TRUE
  461.     STA    DIRECTB            ;set byte
  462.     JMP    SETEND
  463.  
  464. DCT$NO    CALL    TYPE            ;print character
  465.     XRA    A
  466.     STA    DIRECTB            ;set byte
  467.  
  468. SETEND    CALL    ILPRT
  469.     DB    CR,LF,'                All okay?  (Y/N): ',0
  470.     CALL    RESPOND
  471.     CPI    'N'            ;any other key starts the..
  472.     JZ    SETDPS            ;..routine over.
  473.     JMP    MENU2            ;go menu
  474.  
  475. ; routine to show day and time at the command prompt line
  476.  
  477.      IF    RTC AND CW
  478. CLKCTL    EQU    CLKBASE+1    ;clock control port
  479. CLKDATA    EQU    CLKBASE+2    ;clock data port
  480. TIMEDAY    MVI    A,10H        ;prevent reg roll-over during read
  481.     OUT    CLKCTL
  482.      ENDIF            ;rtc and cw
  483.  
  484.      IF    RTC AND SS1
  485. CLKCTL    EQU    CLKBASE+10
  486. CLKDATA    EQU    CLKBASE+11
  487. TIMEDAY    EQU    $
  488.      ENDIF            ;rtc and ss1
  489.  
  490.      IF    RTC AND (CW OR SS1)
  491.     MVI    A,6        ;day of week
  492.     CALL    CLKREAD
  493.     RLC            ; *2 for tbl offset
  494.     LXI    H,DTBL        ;point to day table
  495.     CALL    TBLO        ;table out
  496.     CALL    CS        ;output ", "
  497.     MVI    A,9        ;get month units digit
  498.     CALL    CLKREAD
  499.     MOV    B,A        ;save in b
  500.     MVI    A,10        ;get month tens digit
  501.     CALL    CLKREAD
  502.     MOV    A,B        ;get the units back (don't set flags)
  503.     JZ    SKIP        ;was 1-9 (january-september)
  504.     ADI    10        ;plus 10 if (october-december)
  505. SKIP    DCR    A        ;make 0-11
  506.     RLC            ; *2 for tbl offset
  507.     LXI    H,MTBL        ;point to month table
  508.     CALL    TBLO        ;table out
  509.     MVI    A,' '        ;print a space
  510.     CALL    TYPE        ;output byte
  511.     MVI    A,8        ;get day tens digit
  512.     CALL    CLKREAD
  513.     ANI    3        ;strip leap year bit
  514.     MOV    B,A        ;save day tens for 11, 12, or 13 check
  515.     CNZ    ODGT        ;output the digit, if it is non-zero.
  516.     MVI    A,7        ;get day units digit
  517.     CALL    CLKREAD
  518.     MOV    C,A
  519.     CALL    ODGT        ;output the digit
  520.     MOV    A,B        ;put day tens in reg-a
  521.     CPI    1        ;if one for day tens..
  522.     JZ    THER        ;..don't test for day units else..
  523.     MOV    A,C        ;..get day units back and..
  524.     CPI    1        ;..check if 1, 2, or 3 day units.
  525.     JZ    STER
  526.     CPI    2
  527.     JZ    NDER
  528.     CPI    3
  529.     JZ    RDER
  530. THER    CALL    ILPRT
  531.     DB    'th',0
  532.     JMP    PAST
  533.  
  534. STER    CALL    ILPRT
  535.     DB    'st',0
  536.     JMP    PAST
  537.  
  538. NDER    CALL    ILPRT
  539.     DB    'nd',0
  540.     JMP    PAST
  541.  
  542. RDER    CALL    ILPRT
  543.     DB    'rd',0
  544. PAST    CALL    CS        ;output ", "
  545.     CALL    ILPRT
  546.     DB    '19',0        ;comtemporary century (19th)
  547.     MVI    A,12        ;year tens
  548.     CALL    RDOD        ;read and output digit
  549.     MVI    A,11        ;year units
  550.     CALL    RDOD        ;read and output digit
  551.     CALL    CS        ;output ", "
  552.  
  553. ; call here for time display without day and date
  554.  
  555. TIME    EQU    $
  556.      ENDIF            ;rtc and (cw or ss1)
  557.  
  558.      IF    RTC AND CW AND TIME$ONLY
  559.     MVI    A,10
  560.     OUT    CLKCTL
  561.      ENDIF            ;rtc and cw
  562.  
  563.      IF    RTC AND (CW OR SS1)
  564.     MVI    A,5        ;hour tens
  565.     CALL    CLKREAD
  566.     PUSH    PSW        ;save 12/24. am/pm bits and..
  567.     ANI    3        ;..now strip them.
  568.     CALL    ODGT
  569.     MVI    A,4        ;hour units
  570.     CALL    RDOD        ;read and output digit
  571.     MVI    A,':'        ;separator
  572.     CALL    TYPE
  573.     MVI    A,3        ;minute tens
  574.     CALL    RDOD        ;read and output digit
  575.     MVI    A,2        ;minute units
  576.     CALL    RDOD        ;read and output digit
  577.     MVI    A,':'        ;another separator
  578.     CALL    TYPE
  579.     MVI    A,1        ;seconds tens
  580.     CALL    RDOD        ;read and output digit
  581.     MVI    A,0        ;seconds units
  582.     CALL    RDOD        ;read and output digit        
  583.     POP    PSW        ;restore to test 12/24, am/pm bits
  584.     MOV    B,A        ;save tmp
  585.     ANI    8        ; 24 hour mode?
  586.     JNZ    T4HR        ;yes, print trailing spaces at exit ret.
  587.     MOV    A,B        ;restore
  588.     ANI    4        ;am or pm?
  589.     JZ    AM        ;if am, branch.
  590.     CALL    ILPRT        ;pm
  591.     DB    ' pm  ',0    ;do afternoon or..
  592.     JMP    FOO
  593.  
  594. T4HR    CALL    ILPRT        ; 2 spaces after 24-hr mode display
  595.     DB    '  ',0
  596.     JMP    FOO
  597.  
  598. AM    CALL    ILPRT
  599.     DB    ' am  ',0    ;..morning display.
  600.      ENDIF            ;rtc and (cw or ss1)
  601.  
  602.      IF RTC AND CW
  603. FOO    XRA    A        ;let register..
  604.     OUT    CLKCTL        ;..go free.
  605.     RET
  606.  
  607. CLKREAD    ORI    20H        ;add register offset
  608.     OUT    CLKDATA        ;this digit is wanted so..
  609.     PUSH    PSW        ;..a short..
  610.     POP    PSW        ;..delay then..
  611.     IN    CLKDATA        ;..go read it.
  612.     ORA    A        ;set flags
  613.     RET
  614.      ENDIF            ;rtc and cw
  615.  
  616.      IF RTC AND SS1
  617. FOO    RET
  618.  
  619. CLKREAD    ORI    10H+40H        ;register offset and hold
  620.     OUT    CLKCTL
  621.     IN    CLKDATA
  622.     PUSH    PSW        ;save data
  623.     XRA    A        ;let register..
  624.     OUT    CLKCTL        ;..go free.
  625.     POP    PSW        ;data back to a-reg
  626.     ORA    A        ;set flags
  627.     RET
  628.      ENDIF            ;rtc and ss1
  629.  
  630. ; calendar subroutines
  631.  
  632.      IF    RTC AND (CW OR SS1)
  633. RDOD    CALL    CLKREAD        ;read and output digit
  634. ODGT    ORI    30H        ;convert to ascii
  635.     MOV    E,A
  636.     JMP    TYPE
  637.  
  638. TBLO    MOV    E,A        ;shift factor..
  639.     MVI    D,0        ;..into de-pair.
  640.     DAD    D        ;add offset to hl-pair
  641.     MOV    E,M        ;put address into..
  642.     INX    H
  643.     MOV    D,M        ;..de-pair.  then..
  644.     XCHG            ;..into hl-pair and..
  645.     JMP    TEXTOUT        ;..go display it.
  646.  
  647. CS    CALL    ILPRT
  648.     DB    ', ',0        ;print ", "
  649.     RET
  650.  
  651. ; dispatch tables
  652.  
  653. MTBL    DW    JAN        ;month table
  654.     DW    FEB
  655.     DW    MAR
  656.     DW    APR
  657.     DW    MAY
  658.     DW    JUN
  659.     DW    JUL
  660.     DW    AUG
  661.     DW    SEP
  662.     DW    OCT
  663.     DW    NOV
  664.     DW    DEC
  665. JAN    DB    'January','@'
  666. FEB    DB    'February','@'
  667. MAR    DB    'March','@'
  668. APR    DB    'April','@'
  669. MAY    DB    'May','@'
  670. JUN    DB    'June','@'
  671. JUL    DB    'July','@'
  672. AUG    DB    'August','@'
  673. SEP    DB    'September','@'
  674. OCT    DB    'October','@'
  675. NOV    DB    'November','@'
  676. DEC    DB    'December','@'
  677.  
  678. DTBL    DW    SUN        ;daytable
  679.     DW    MON
  680.     DW    TUE
  681.     DW    WED
  682.     DW    THU
  683.     DW    FRI
  684.     DW    SAT
  685.  
  686. SUN    DB    'Sunday','@'
  687. MON    DB    'Monday','@'
  688. TUE    DB    'Tuesday','@'
  689. WED    DB    'Wednesday','@'
  690. THU    DB    'Thursday','@'
  691. FRI    DB    'Friday','@'
  692. SAT    DB    'Saturday','@'
  693.      ENDIF             ;rtc and (cw or ss1)
  694.  
  695. ; s a p   (sort and pack routine)
  696.  
  697. ; obtain 'bios' vectors
  698.  
  699. S$A$P    LDA    ALERTFG        ; 'sap' not allowed if..
  700.     ORA    A        ;..a file is being..
  701.     JNZ    FILOPEN        ;..saved in terminal mode.
  702.  
  703. ; move 'bios' addresses into place
  704.  
  705.     LXI    D,S$WBOOT    ;point to local storage table
  706.     LHLD    CPM$BASE+1    ;entry address for 'bios' jump table
  707.     MVI    B,53
  708.     CALL    MOVE
  709.     MVI    C,GETVERS    ;cp/m function 12
  710.     CALL    BDOS
  711.     MOV    A,H        ;hl-pair --> 0020h if cp/m 2
  712.     ORA    A        ;exit if..
  713.     JNZ    MPM$YES        ;..mp/m.
  714.     ORA    L        ;else store a zero..
  715.     STA    VERFLG        ;..if cp/m 1.
  716.  
  717. ; setup for selecting drive and loading disk parmeter block
  718.  
  719.     CALL    SETFCB        ;get comm7 command line..
  720.     CALL    MOVEFCB        ;..drive entry, if..
  721.     LDA    FCB        ;..one entered.
  722.     DCR    A
  723.     JP    SELDISK        ;branch if specific drive requested
  724.     MVI    C,INQDISK    ;otherwise get current default drive
  725.     CALL    BDOS        ;query 'bdos' for drive
  726. SELDISK    MOV    C,A
  727.     CALL    SELDSK        ;direct 'bios' call for 'dph'
  728.     LDA    VERFLG        ;if cp/m 1.4, show..
  729.     ORA    A        ;..no-support..
  730.     JZ    CPM14        ;..message.
  731.  
  732. ; determine cp/m 2 disk parameter block from address base in hl-pair
  733.  
  734.     MOV    E,M        ;base of 'dph' for selected drive
  735.     INX    H
  736.     MOV    D,M
  737.     INX    H
  738.     XCHG
  739.     SHLD    RECTBL
  740.     XCHG
  741.     LXI    D,8        ;offset to 'dpb' within header..
  742.     DAD    D        ;..returned by 'seldsk' in cp/m 2.
  743.     MOV    A,M        ;get address of 'dpb'
  744.     INX    H
  745.     MOV    H,M
  746.     MOV    L,A
  747.     LXI    D,DPB        ;point to destination: our 'dpb'
  748.     MVI    B,15        ; 'dpb' length
  749.     CALL    MOVE
  750.  
  751. ; 'sap' main-line
  752.  
  753.     CALL    RD$DIR        ;read requested drive directory
  754.     CALL    CLEAN
  755.     CALL    S$SORT        ; 'sap' sort
  756.     CALL    PACK
  757.     CALL    WR$DIR
  758.     CALL    ILPRT
  759.     DB    '-- done',CR,LF,LF,0
  760.     CALL    RESET        ;rewritten directory requires system reset
  761.     JMP    MENU        ;return to comm7 command line
  762.  
  763. ; 'sap' subroutines
  764.  
  765. ; read (or write) directory routines
  766.  
  767. RD$DIR    CALL    ILPRT
  768.     DB    CR,LF,LF,'---> Reading, ',0
  769.     XRA    A
  770.     JMP    DO$DIR
  771.  
  772. WR$DIR    LDA    NOSSWAP        ;rewrite unnecessary?
  773.     ORA    A
  774.     JZ    OK$NOW
  775.     CALL    ILPRT
  776.     DB    'writing ',0
  777.     MVI    A,1
  778. DO$DIR    STA    WR$FLAG
  779.     LHLD    SYSTRK
  780.     CALL    DO$TRAK        ;set track
  781.     LXI    H,0
  782.     SHLD    SECTOR
  783.     LHLD    DRM        ;number of directory entries..
  784.     INX    H        ;..relative to 1.
  785.     MVI    B,2+1        ;divide by 4 to..
  786.     CALL    SHIFTLP        ;..get sector count.
  787.     SHLD    DIRCNT
  788.     LXI    H,BOTTRAM
  789.     SHLD    ADDR        ;for dma address
  790. DIRLOP    LHLD    SECTOR        ;get sectors per track
  791.     INX    H
  792.     XCHG
  793.     LHLD    SPT        ;current sector
  794.     CALL    SUBDE        ; 'sector' minus 'spt'
  795.     XCHG
  796.     JNC    NO$TROV        ;branch if no track overflow
  797.     LHLD    TRACK
  798.     INX    H
  799.     CALL    DO$TRAK
  800.     LXI    H,1        ;rewind sector number
  801. NO$TROV    CALL    DO$SEC        ;set current sector
  802.     LHLD    ADDR
  803.     MOV    B,H        ;set up dma address
  804.     MOV    C,L
  805.     CALL    SSETDMA
  806.     LDA    WR$FLAG        ;time to figure out..
  807.     ORA    A        ;..if we are reading..
  808.     JNZ    D$WRT        ;..or writing.
  809.  
  810. ; read
  811.  
  812.     CALL    SREAD
  813.     ORA    A        ;test flags on read
  814.     JNZ    RERROR        ;nz --> error, else good read.
  815.     JMP    MORE
  816.  
  817. ; directory already sap'd
  818.  
  819. OK$NOW    CALL    ILPRT
  820.     DB    '(previously sorted) -- done',CR,LF,LF,0
  821.     CALL    RESET
  822.     JMP    MENU
  823.  
  824. ; write
  825.  
  826. D$WRT    MVI    C,1        ;for cp/m 2 deblocking bios's
  827.     CALL    SWRITE
  828.     ORA    A        ;test flags on write
  829.     JNZ    WERROR        ;nz --> bad directory write
  830.  
  831. ; good write (or read)
  832.  
  833. MORE    LHLD    ADDR        ;bump dma address for next pass
  834.     LXI    D,80H
  835.     DAD    D
  836.     SHLD    ADDR
  837.     LHLD    DIRCNT        ;countdown entries
  838.     DCX    H
  839.     SHLD    DIRCNT
  840.     MOV    A,H        ;test for zero left
  841.     ORA    L
  842.     JNZ    DIRLOP        ;loop till zero
  843.  
  844. ; directory i/o done -- reset dma address
  845.  
  846.     LXI    B,80H
  847.     JMP    SSETDMA        ;returns to caller
  848.  
  849. ; track and sector update routines
  850.  
  851. DO$TRAK    SHLD    TRACK
  852.     MOV    B,H
  853.     MOV    C,L
  854.     CALL    SETTRK
  855.     RET
  856.  
  857. DO$SEC    SHLD    SECTOR
  858.     MOV    B,H
  859.     MOV    C,L
  860.     LHLD    RECTBL
  861.     XCHG
  862.     DCX    B
  863.     CALL    SECTRN
  864.     MOV    B,H
  865.     MOV    C,L
  866.     LDA    VERFLG
  867.     ORA    A
  868.     RZ
  869.     CALL    SETSEC
  870.     RET
  871.  
  872. ; clean -- reformat with e5's -- delete files of zero length (except those
  873. ; starting with fn's of '-')
  874.  
  875. CLEAN    LXI    H,0        ;i = 0
  876. CLEANLP    SHLD    I
  877.     CALL    INDEX        ;hl = bottram + 16 * i
  878.     MOV    A,M        ;jump if this is a deleted file
  879.     CPI    0E5H
  880.     JZ    FILL$E5
  881.     LXI    D,12
  882.     DAD    D        ;hl = hl + 12
  883.     MOV    A,M        ;check extent field
  884.     ORA    A
  885.     JNZ    CLBUMP        ;skip if not extent zero
  886.     INX    H        ;point to record count field
  887.     INX    H
  888.     MOV    A,M        ;get s2 byte (extended rc)
  889.     ANI    0FH        ;for cp/m 2, 0 for cp/m 1.
  890.     MOV    E,A
  891.     INX    H
  892.     MOV    A,M        ;check record count field
  893.     ORA    E
  894.     JNZ    CLBUMP        ;jump if non-zero
  895.     LHLD    I        ;clear all 32 bytes of..
  896.     CALL    INDEX        ;..directory entry to e5h.
  897.     INX    H
  898.     MOV    A,M        ;get first char of filename
  899.     DCX    H        ;  (ward christensen's cat pgms
  900.     CPI    '-'        ;  have diskname of zero length
  901.     JZ    CLBUMP        ;  that start with '-', don't delete.)
  902. FILL$E5    MVI    C,32        ;number of bytes to clear
  903. FILLOP    MVI    M,0E5H        ;make it all e5's
  904.     INX    H
  905.     DCR    C
  906.     JNZ    FILLOP
  907. CLBUMP    LHLD    DRM        ;get count of filenames
  908.     INX    H
  909.     XCHG
  910.     LHLD    I        ;our current count
  911.     INX    H
  912.     PUSH    H
  913.     CALL    SUBDE        ;subtract
  914.     POP    H
  915.     JC    CLEANLP        ;loop till all cleaned
  916.     RET
  917.  
  918. ; fcb buffer offset
  919.  
  920. INDEX    DAD    H
  921.     DAD    H
  922.     DAD    H
  923.     DAD    H
  924.     DAD    H
  925.     LXI    D,BOTTRAM
  926.     DAD    D
  927.     RET
  928.  
  929. ; sort directory
  930.  
  931. S$SORT    XRA    A
  932.     STA    NOSSWAP        ;set zero flag to indicate 'already sorted'
  933.     CALL    ILPRT
  934.     DB    'sorting ',0
  935.     LXI    H,0        ;i = 0
  936.     SHLD    I
  937. SSORT1    LHLD    I        ;j = i + 1
  938.     INX    H
  939.     SHLD    J
  940. SSORT2    CALL    COMP        ;if name(j) < name(i), swap.
  941.     CC    S$SWAP
  942.     LHLD    J        ;j = j + 1
  943.     INX    H
  944.     SHLD    J
  945.     XCHG
  946.     LHLD    DRM
  947.     INX    H
  948.     XCHG
  949.     PUSH    H
  950.     CALL    SUBDE        ;if j < drm goto sort2
  951.     POP    H
  952.     JC    SSORT2
  953.     LHLD    I        ;i = i + 1
  954.     INX    H
  955.     SHLD    I
  956.     XCHG
  957.     LHLD    DRM
  958.     XCHG
  959.     CALL    SUBDE        ;if i < drm goto sort1
  960.     JC    SSORT1
  961.     RET
  962.  
  963. ; compare subroutine
  964.  
  965. COMP    LHLD    I        ;hl = bottram + 16 * i
  966.     CALL    INDEX
  967.     PUSH    H
  968.     LHLD    J        ;hl = bottram + 16 * j
  969.     CALL    INDEX
  970.     XCHG
  971.     POP    H
  972.     MVI    C,13        ;number of bytes to compare
  973. COMP1    MOV    A,M        ;get next byte
  974.     ANI    7FH        ;remove attributes
  975.     MOV    B,A        ;save in b
  976.     LDAX    D
  977.     ANI    7FH        ;remove attributes
  978.     CMP    B        ;compare character
  979.     RNZ            ;return if not equal
  980.     INX    D
  981.     INX    H
  982.     DCR    C        ;loop thru first 13 bytes
  983.     JNZ    COMP1
  984.     XRA    A        ;clear flags and exit
  985.     RET
  986.  
  987. ; swap subroutine
  988.  
  989. S$SWAP    MVI    A,1
  990.     STA    NOSSWAP        ;swap used, rewrite needed.
  991.     LHLD    I
  992.     CALL    INDEX
  993.     PUSH    H
  994.     LHLD    J
  995.     CALL    INDEX
  996.     XCHG
  997.     POP    H
  998.     MVI    C,32
  999. S$SWAP1    LDAX    D
  1000.     MOV    B,A
  1001.     MOV    A,M
  1002.     STAX    D
  1003.     MOV    M,B
  1004.     INX    D
  1005.     INX    H
  1006.     DCR    C
  1007.     JNZ    S$SWAP1
  1008.     RET
  1009.  
  1010. ; pack directory
  1011.  
  1012. PACK    CALL    ILPRT
  1013.     DB    'and packing, ',0
  1014.     LXI    H,0        ;i = 0
  1015. PACK1    SHLD    I
  1016.     CALL    INDEX        ;hl = bottram + 16 * i
  1017.     LXI    D,9
  1018.     DAD    D        ;hl = hl + 9
  1019.     MOV    A,M        ;jump if filetype not 'x$$'..
  1020.     SUI    '0'        ;..where 0.le.x.le.9.
  1021.     JC    PACK2
  1022.     CPI    10
  1023.     JNC    PACK2
  1024.     STA    J
  1025.     INX    H
  1026.     MOV    A,M
  1027.     CPI    '$'
  1028.     JNZ    PACK2
  1029.     INX    H
  1030.     MOV    A,M
  1031.     CPI    '$'
  1032.     JNZ    PACK2
  1033.     INX    H        ;set extent number to x
  1034.     LDA    J
  1035.     MOV    M,A
  1036.     DCX    H        ;set filetype to '$$$'
  1037.     MVI    M,'$'
  1038.     DCX    H
  1039.     MVI    M,'$'
  1040.     DCX    H
  1041.     MVI    M,'$'
  1042. PACK2    LHLD    I        ;i = i + 1
  1043.     INX    H
  1044.     XCHG
  1045.     LHLD    DRM
  1046.     INX    H
  1047.     XCHG
  1048.     PUSH    H
  1049.     CALL    SUBDE
  1050.     POP    H        ;loop until i > drm
  1051.     JC    PACK1
  1052.     RET
  1053.  
  1054. ; 'sap' error messages
  1055.  
  1056. ; cp/m 1.4 not allowed with comm7
  1057.  
  1058. CPM14    CALL    ILPRT
  1059.     DB    CR,ESC,ETEOP,'++ Comm7 not used with CP/M 1.4 ++',0
  1060.     JMP    MSGREAD
  1061.  
  1062. ; mp/m not allowed with comm7
  1063.  
  1064. MPM$YES    CALL    ILPRT
  1065.     DB    CR,ESC,ETEOP,'++ SAP not used with MP/M ++',0
  1066.     JMP    MSGREAD
  1067.  
  1068. ; read error
  1069.  
  1070. RERROR    CALL    ILPRT
  1071.     DB    CR,LF,'++ Read error -- directory unchanged ++'
  1072.     DB    CR,LF,BELL,0
  1073.     JMP    MENU
  1074.  
  1075. ; write error
  1076.  
  1077. WERROR    CALL    ILPRT
  1078.     DB    '++ Write error -- directory in '
  1079.     DB    'unknown condition ++',BELL,CR,LF,0
  1080.     JMP    MENU
  1081.  
  1082.     LINK    COMM723D    ;chain to 'comm723d.asm' using lasm.com
  1083.