TITL SYST command - List things about the system
*   
*  List things about the system.
*   
*  Written:  Michael Sherman   8/25/77
*  Modified: David Richards    11/8/78
*   
*  form 1:  SYST [L]
*  form 2:  SYST /[u][,L]
*
*  SYST gets its information from the System Global Area in
*  memory (form 1) or from file SYSGLOBL on unit u (form 2).
*  In form 2, if the u is missing the default unit is used.
*
*  The 'L' results in a more lengthy listing.
*
*  Typing MODE or CNTL-@ will stop the program.
*
 ASCF 0
*   
 COPY NPTDEFS
GLLOG EQU GLRBW
 ORG 100H
 XEQ 100H
*   
*   
**************************************************************
*                      ////
*  THE FOLLOWING TWO EQUATES MUST BE CHANGED IF EITHER
*  THE MINIMUM NUMBER OF FCB'S IN THE SYSTEM OR THE SIZE
*  OF FCB'S IS CHANGED.
*   
MINFCB EQU 5  The product of these is used as an offset into
LNFCB EQU 34  the SYSGLOBL file.
*   
**************************************************************
*   
*   
YES EQU -1
NO EQU 0
NONE EQU 0
MODE EQU 0  CNTL-@  (ascii NULL)
CR EQU 0DH
LF EQU 0AH
*   
*   
SYST LXI SP,STACK  Set the stack.
 CALL GETCI  Put current CI input/output #s in CI/COFILE.
 LHLD SYSGLO  HL-> in memory copy of SYSGLOBL.
 SHLD GLOBAL  Tells GETGLO where to look.
 CALL NONBL  Read next non-blank char from CIFILE to A.
 JZ RDGLO  Zero flag set => no more characters.
 CPI '/'  Is this form 1 or 2?  (See above)
 JNZ SYST2
 CALL NONBL  Form 2.  Get unit specification if present.
 JZ SYST0  No unit was specified -- use default.
 CPI ','  A comma after '/' means use default, then get 'L'.
 JNZ SYST1  A unit was specified and is in reg. A.
SYST0 LXI D,GLUNI  Otherwise use default unit.
 PUSH PSW
 CALL GETGLO  Puts default unit # in A. (HL-> default unit also)
 ADI 48  Make it ascii.
 STA UNIT
 POP PSW
 CPI ','
 JZ SYSLNG  an 'L' is coming
 JMP RDGLO
SYST1 STA UNIT  Include the unit number with the file name.
 CALL NONBL
 JZ RDGLO  No chars => user doesn't want long listing.
 CPI ','  Must be comma after unit spec. if there is anything.
 JNZ BADSYN  Command syntax error.
SYSLNG CALL NONBL  Get the 'L'.
SYST2 CALL MAP  Lower case is ok.
 CPI 'L'
 JNZ BADSYN  There aren't any other options.
 MVI A,YES
 STA LONG  Flag for long listing.
 CALL NONBL  That should be all the chars in the command.
 JNZ BADSYN  What???
*   
* At this point the unit number is in UNIT (or else NONE
* is stored there for an in-memory listing) and LONG is
* set to YES or NO appropriately.  Now read in the correct
* SYSGLOBL if necessary.
*   
RDGLO CALL CHECK  Aborted by user?  Won't return if so.
 LDA UNIT
 CPI NONE
 JZ START  Just use the in-memory global area.
 LXI H,FNAM  File name for PSCAN.
 LXI D,FNAM  Buffer req'd by PSCAN.
 MVI A,PSOP+40H  Open SYSGLOBL file.
 CALL PSCAN
 MOV A,E  Get error # or file # of open file.
 JC PTERR  (It can't be a field error)
 STA FNUM  Remember the file #.
 LXI D,CXBUF  Where we will read the SYSGLOBL file in.
 LXI B,0FFFFH  No limit on # chars to read.
 CALL SYS
 DB RBLOP
 JMP CLOSIT  Error--hopefully EOF.
 CALL OUST  We should never get here.
 ASC /Something terrible has happened--no end to SYSGLOBL?/
 DB 0
 JMP EXIT
*   
*  SYSGLOBL/u has been read in to CXBUF.
*   
CLOSIT CPI EREOF  We did finish with an EOF, didn't we?
 JNZ PTERR  Nope.  God (read 'UXOP') only knows what happened.
 LDA FNUM  Close the file.
 CALL SYS
 DB CLOOP
 JMP PTERR
 LXI H,CXBUF
 LXI D,MINFCB*LNFCB  There is this much space before globals.
 DAD D
 SHLD GLOBAL  Point to global area for GETGLO.
*   
* Print the required information from the global area pointed
* to by GLOBAL.
*   
START CALL HEADER  Print name, date, etc.
 LDA LONG  Long listing?
 CPI NO
 JZ STRT1  Nope.
 CALL FILFLG  Files and flags.
 CALL SYSTEM  System info.
 XRA A  Flush the buffer.
 CALL PUTCHR
 JMP EXIT
STRT1 CALL CRLF
 CALL LIN10  Print amount of buffer space left.
 CALL CRLF
EXIT CALL SYS
 DB RETOP
*   
*  Major subroutines:
*   
HEADER CALL LIN1
 CALL LIN2
 RET
*   
FILFLG CALL LIN3  ---Files---  ---Switches---  line.
 CALL LIN4
 CALL LIN5
 CALL LIN6
 CALL LIN7
 RET
*   
SYSTEM CALL LIN8  ---System---  line.
 CALL LIN9
 CALL LIN10 Lines 10 & 11 go together. (Available buffer space.)
 CALL LIN12
 CALL LIN13
 CALL LIN14
 CALL LIN15
 RET
*   
*  The line subroutines:
*   
LIN1 CALL CRLF  We are starting a fresh line.
 CALL CHECK  Does user want out?
 MVI A,10  Print 10 blanks.
 CALL BLANKS
 CALL OUST
 ASC / PTDOS System Information From /
 DB 0
 CALL CHECK
 LDA UNIT  Memory or disk?
 CPI NONE
 JNZ LN1LAB  Disk.
 CALL OUST
 ASC /Memory/
 DB 0
 RET
LN1LAB STA UNUM  Unit number.
 CALL OUST
 ASC /Unit /
UNUM DB 0
 DB 0
 RET
*   
*   
LIN2 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /Disk name: /
 DB 0
 CALL CHECK
 CALL PRNAME  Print the name.
 CALL CHECK
 CALL OUST
 ASC /    Version: 1./
 DB 0
 CALL CHECK
 LXI D,GLVER
 CALL GETGLO  Put system version in A.
 PUSH PSW
 ANI 0F0H  Get most significant part.
 RRC
 RRC
 RRC
 RRC
 CALL DIGIT  Print A as a hex digit.
 CALL CHECK
 CALL OUST
 ASC / (mod /
 DB 0
 CALL CHECK
 POP PSW  System version again.
 ANI 0FH  Least significant part.
 CALL DIGIT
 MVI A,')'
 CALL PUTCHR
 CALL CHECK
 CALL OUST
 ASC /    Date: /
 DB 0
 CALL CHECK
 CALL PRDATE  Print the date.
 RET
*   
*   
LIN3 CALL CRLF  This prints the header for files and switches.
 CALL CHECK
 CALL OUST
 ASC /---Files---   /
 DB 0
 CALL CHECK
 MVI A,21
 CALL DASH  21 dashes.
 CALL CHECK
 CALL OUST
 ASC /Switches/
 DB 0
 CALL CHECK
 CALL DASH  21 more.
 RET
*   
*   
LIN4 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /CI in:   #/
 DB 0
 CALL CHECK
 LXI D,GLCIF
 CALL GETGLO  Sets A= CI's input file #.
 CALL DIGIT
 CALL OUST
 ASC /   Echo:/  (Three spaces before "Echo:")
 DB 0
 CALL CHECK
 MVI A,7
 CALL BLANKS
 CALL CHECK
 LXI D,GLECH
 CALL GETGLO  Sets A= Status of echo flag.
 CALL ONOFF  Print 'on ' or 'off'  (both three chars)
 CALL CHECK
 CALL OUST
 ASC /   System log enable:/  (Three spaces)
 DB 0
 CALL CHECK
 MVI A,7
 CALL BLANKS
 CALL CHECK
 LXI D,GLLOG
 CALL GETGLO
 CALL ONOFF
 RET
*   
*   
LIN5 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /CI out:  #/
 DB 0
 CALL CHECK
 LXI D,GLCOF
 CALL GETGLO
 CALL DIGIT  Print the output file's number.
 CALL OUST
 ASC /   Upshift:    /  3 spaces, "Upshift", then 4 spaces.
 DB 0
 CALL CHECK
 LXI D,GLUPS
 CALL GETGLO  A= status of upshift flag.
 CALL ONOFF  Print the status.
 CALL CHECK
 CALL OUST
 ASC /   Interrupt enable:/  (three spaces)
 DB 0
 CALL CHECK
 MVI A,8
 CALL BLANKS
 CALL CHECK
 LXI D,GLIF1
 CALL GETGLO
 CALL ONOFF
 RET
*   
*   
LIN6 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /CI echo: #/
 DB 0
 CALL CHECK
 LXI D,GLECF
 CALL GETGLO  Get the echo file's number into A.
 CALL DIGIT  Print it.
 CALL OUST
 ASC "   Binary I/O: "  (three spaces, "Binary...", one space)
 DB 0
 CALL CHECK
 LXI D,GLBIO
 CALL GETGLO
 CALL ONOFF
 CALL CHECK
 CALL OUST
 ASC "   Read-back/Write lock:    " (three spaces)
 DB 0
 CALL CHECK
 MVI A,NO
 STA EXTRA  "on" should not be followed by a space.
 LXI D,GLRBC
 CALL GETGLO
 CALL ONOFF
 CALL CHECK
 CALL SLASH  Print a slash.
 LXI D,GLLOK
 CALL GETGLO
 CALL ONOFF
 RET
*   
*   
LIN7 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /Utility: #/
 DB 0
 CALL CHECK
 LXI D,GLUTF
 CALL GETGLO
 CALL DIGIT
 CALL OUST
 ASC /   Verbose:    /  (three spaces, "Verbos...", four spaces)
 DB 0
 CALL CHECK
 MVI A,YES
 STA EXTRA  We want "on" to be followed by a space.
 LXI D,GLVRB
 CALL GETGLO
 CALL ONOFF
 CALL CHECK
 CALL OUST
 ASC "   Sense switch 1/2:"  (three spaces)
 DB 0
 CALL CHECK
 MVI A,8
 CALL BLANKS
 CALL CHECK
 MVI A,NO
 STA EXTRA  Now we want "on" to be 2 chars.
 LXI D,GLSWI
 CALL GETGLO  A= status of switch 1.
 CALL ONOFF
 CALL SLASH  Print a '/'
 CALL CHECK
 INX H
 MOV A,M  A= status of switch 2.
 CALL ONOFF
 RET
*   
*   
LIN8 CALL CRLF  First line for system info. (---System---)
 CALL CHECK
 MVI A,27
 CALL DASH  27 dashes.
 CALL CHECK
 CALL OUST
 ASC /Parameters/
 DB 0
 CALL CHECK
 CALL DASH  27 more.
 RET
*   
*   
LIN9 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /Default unit: /
 DB 0
 CALL CHECK
 LXI D,GLUNI
 CALL GETGLO
 CALL DIGIT
 CALL CHECK
 MVI A,16
 CALL BLANKS
 CALL CHECK
 CALL OUST
 ASC /Maximum number of units: /
 DB 0
 CALL CHECK
 LXI D,GLMXU
 CALL GETGLO
 CALL DIGIT
 RET
*   
*   
LIN10 CALL CRLF  Lines 10 & 11 are always printed together.
 CALL CHECK
 CALL OUST  Line 11 is not its own subroutine.
 ASC /Lowest system address: /
 DB 0
 CALL CHECK
 LXI D,GLLOW+1
 CALL GETGLO
 STA LOWAD+1  We need this number for later.
 CALL HEX  Output A as two hex digits.
 DCX H
 MOV A,M  Get least sig. byte of address.
 STA LOWAD
 CALL HEX
 CALL CHECK
 MVI A,4
 CALL BLANKS
 CALL CHECK
 CALL OUST
 ASC /User protect address: /
 DB 0
 CALL CHECK
 LXI D,GLPRO
 CALL GETGLO
 CALL HLPTHX
LIN11 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /Amount of unused buffer space: /
 DB 0
 CALL CHECK
 LXI D,GLMIN
 CALL GETGLO
 STA MINAD  We need this number for calculations.
 INX H
 MOV A,M
 STA MINAD+1
 LHLD LOWAD  Get lowest address system can use
 XCHG .  and put it in DE.
 LHLD MINAD  Get lowest address currently in use
 CALL DSUB  and subtract lowest available address.
 MOV A,H  Print the answer in hex.
 CALL HEX
 MOV A,L
 CALL HEX
 CALL CHECK
 PUSH H
 CALL OUST
 ASC / = /
 DB 0
 POP H
 CALL DOUT  Print the answer in decimal.
 CALL CHECK
 CALL OUST
 ASC / (decimal) bytes/
 DB 0
 RET
*   
*   
LIN12 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /CI return trap: /
 DB 0
 CALL CHECK
 LXI D,GLTRP
 CALL GETGLO  HL-> the trap setting.
 CALL HLPTHX  Print what HL points to in hex (4 digits)
 CALL CHECK
 MVI A,11
 CALL BLANKS
 CALL CHECK
 CALL OUST
 ASC /Disk interrupt wait address: /
 DB 0
 CALL CHECK
 LXI D,GLBD1
 CALL GETGLO
 CALL HLPTHX
 RET
*   
*   
LIN13 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC "Soft(2)/Medium(1)/Hard(0) error trap addresses: "
 DB 0
 CALL CHECK
 LXI D,GLERS
 CALL GETGLO
 CALL HLPTHX  Level 2 trap.
 CALL SLASH
 CALL CHECK
 LXI D,GLERM
 CALL GETGLO
 CALL HLPTHX  Level 1 trap.
 CALL SLASH
 CALL CHECK
 LXI D,GLERH
 CALL GETGLO
 CALL HLPTHX
 RET
*   
*   
LIN14 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC "Console input/output/test routine addresses: "
 DB 0
 CALL CHECK
 LXI D,GLRCH
 CALL GETGLO
 CALL HLPTHX  Print input routine address. (RCH)
 CALL SLASH
 CALL CHECK
 LXI D,GLWCH
 CALL GETGLO
 CALL HLPTHX  Print output routine address. (WCH)
 CALL SLASH
 CALL CHECK
 LXI D,GLTCH
 CALL GETGLO
 CALL HLPTHX  Print test routine address. (TCH)
 RET
*   
*   
LIN15 CALL CRLF
 CALL CHECK
 CALL OUST
 ASC /Number of nulls after linefeed: /
 DB 0
 CALL CHECK
 LXI D,GLNCT
 CALL GETGLO
 MOV L,A
 MVI H,0  Set HL= number of nulls.
 CALL DOUT  Print HL as a decimal number.
 CALL CHECK
 CALL OUST
 ASC / (decimal)/
 DB 0
 RET
*   
*  Low level subroutines for this program only:
*   
PRNAME LXI D,GLNAM  Print the disk name with blank fill.
 CALL GETGLO
 MVI B,8  The number of characters to write.
PRNM1 MOV A,M
 INX H
 ORA A
 JNZ PRNM2
 MVI A,' '  Replace NULL with SPACE
PRNM2 CALL PUTCHR
 DCR B
 JNZ PRNM1
 RET
*   
PRDATE LXI D,GLDAT  Print the date mm/dd/yy.
 CALL GETGLO
 CALL HEX  Print out the month which is in A.
 CALL SLASH
 INX H
 MOV A,M
 CALL HEX  The day.
 CALL SLASH
 INX H
 MOV A,M
 CALL HEX  The year.
 RET
*   
GETGLO LHLD GLOBAL  Return the byte whose offset from SYSGLO
 DAD D  is in DE.  Also, leave HL pointing there.
 MOV A,M
 RET
*   
DIGIT CPI 10  Decimal digit?
 JM DIGI1  Yes.
 ADI 7  No. Hex digit.
DIGI1 ADI 48
 CALL PUTCHR
 RET
*   
DASH PUSH PSW  Print A dashes.
 PUSH B
 MOV B,A
 MVI A,'-'
DASH1 CALL PUTCHR
 DCR B
 JNZ DASH1
 POP B
 POP PSW
 RET
*   
ONOFF ORA A
 JZ ONF1
 CALL OUST  Flag is on.
 ASC /on/
 DB 0
 LDA EXTRA
 CPI NO  Print an extra blank?
 RZ 
 MVI A,' '
 CALL PUTCHR
 RET
ONF1 CALL OUST  Flag is off.
 ASC /off/
 DB 0
 RET
*   
NOYES ORA A
 JZ NOYS1
 CALL OUST  Flag is on (yes).
 ASC /yes/
 DB 0
 RET
NOYS1 CALL OUST  Flag is off (no).
 ASC /no/
 DB 0
 LDA EXTRA
 CPI NO
 RZ 
 MVI A,' '
 CALL PUTCHR
 RET
*   
SLASH MVI A,'/'  Print a slash.
 CALL PUTCHR
 RET
*   
HLPTHX INX H  Print the hex number that HL points to.
 MOV A,M
 CALL HEX  Most significant byte.
 DCX H
 MOV A,M
 CALL HEX  Least significant byte.
 RET
*   
CHECK PUSH PSW  Does user want out?
 CALL CONTST
 JZ CHCK1  Nope.
 CALL CONIN
 ANI 7FH  Junk parity.
 CPI MODE
 JNZ CHCK1  User hit something, but not MODE. (cntl-@)
 MVI A,-1
 CALL SYS
 DB CAOP  Close all files...
 JMP PTERR
 JMP EXIT  ...and quit.
CHCK1 POP PSW
 RET
*   
BADSYN MVI A,ERSYN  A syntax error occurred.
 JMP PTERR  Abort program.
*
* GETCI obtains the numbers of the CI's input
* and output files and stores them in CIFILE
* and COFILE, respectively.  All registers except
* BC are changed.
*
GETCI LHLD SYSGLO pointer to global area
 LXI D,GLCIF offset for CI's input file
 DAD D (H,L) now points to the input file's number
 MOV A,M
 STA CIFILE
 LHLD SYSGLO
 LXI D,GLCOF offset for CI's output file
 DAD D
 MOV A,M
 STA COFILE
 RET
CIFILE DB 0
COFILE DB 1
*
*  NONBL returns the next non-blank character from CIFILE
*  in register A.  If the character is a CR, semicolon,
*  a NULL (ascii 0), or if EOF is encountered then the zero
*  flag is set on return.  In the case of an EOF, the carry
*  flag is also set and the character returned in A is a CR.
*      No registers except A and flags are affected.
*      GETCHR is used for input.
*
NONBL CALL GETCHR  Get character to A.
 RZ .  CR, semi, NULL or EOF encountered.
 CPI ' '  Was it a space?
 JZ NONBL  Yes.
 ORA A  Reset carry. (Zero will be reset also.)
 RET
*
*  GETCHR returns the next character from CIFILE
*  in register A.  If the character is a CR, semicolon,
*  a NULL (ascii 0), or if EOF is encountered then the zero
*  flag is set on return.  In the case of an EOF, the carry
*  flag is also set and the character returned in A is a CR.
*      No registers except A and flags are affected.
*
GETCHR PUSH B
 PUSH D
 PUSH H
 LDA CIFILE  Get the file # of the CI input file.
 CALL RB
 JMP GETC1  Error--hopefully EOF.
 POP H
 POP D
 POP B
 ORA A  Set flags, clear carry.
 RZ .  Return if zero.
 CPI 0DH
 RZ .  Return if CR.
 CPI ';'
 RZ .
 ORA A  Just a regular character -- reset zero and carry.
 RET
GETC1 CPI EREOF  We got an error.  Is it EOF?
 JNZ PTERR  Must be defined in calling program.
 MVI A,0DH  EOF pretends it's a CR.
 STC .  Set carry to indicate EOF. (Zero flag is already set.)
 POP H
 POP D
 POP B
 RET
*
*  Map lower case letters into upper case.  Letter comes in
*  A and leaves in A.  Only A and flags are affected.
*
MAP CPI 'a'  'a'<=A ?
 RM .  Nope.  No map necessary.
 CPI 'z'+1  A<='z' ?
 RP .  Nope.  No map necessary.
 SUI 32  'a'=>'A', etc.
 RET
*
*  OUST writes the string beginning with the address on the
*  top of the stack.   The string is terminated by a zero
*  byte, and OUST returns to the address just after that byte.
*     Thus, call is:  CALL OUST
*                     ASC /Message./
*                     DB 0
*                    * OUST returns here.
*
*  Output is done through PUTCHR.
*  No registers or flags are affected.
OUST XTHL .  Get ptr to string and push H.
 PUSH PSW
OUST0 MOV A,M
 INX H
 ORA A
 CNZ PUTCHR  Returns with flags unchanged.
 JNZ OUST0
 POP PSW
 XTHL .  Return address to stack, restore HL.
 RET
*
*  Send carriage return/linefeed to the COFILE.  No registers
*  or flags affected.  Calls 'PUTCHR'.
*
CRLF PUSH PSW
 MVI A,0DH  CR
 CALL PUTCHR
 MVI A,0AH  LF
 CALL PUTCHR
 POP PSW
 RET
*
*  BLANKS outputs A blanks to the COFILE.  No registers or
*  flags are affected.  Calls 'PUTCHR'.
*
BLANKS PUSH PSW
 PUSH B
 ORA A
 JZ BLNK2  A was zero.
 MOV B,A  Count in B.
 MVI A,' '
BLNK1 CALL PUTCHR  Output one blank.
 DCR B
 JNZ BLNK1
BLNK2 POP B
 POP PSW
 RET
*
*  PUTCHR writes one character out to the COFILE.  The character
*  to write comes in A.  On return all registers and flags are
*  unchanged.   Characters are not actually transferred until
*  a CR is received, except for line feeds which go right away.
*
PUTCHR PUSH B
 PUSH D
 PUSH H
 PUSH PSW
 ORA A
 JZ PUTFL  Zero byte means flush buffer.
 CPI 0AH  We transfer line feeds immediately.
 JNZ PUTC1
 MOV B,A  Char for WB
 LDA COFILE
 CALL WB
 JMP PTERR
 JMP PUTC2
PUTC1 LHLD PUTPTR
 MOV M,A
 INX H
 SHLD PUTPTR
 XCHG .
 LXI H,PUTEND
 CALL DSUB  HL=PUTEND-PUTPTR
 MOV A,H
 ORA L
 JZ PUTC3  Buffer overflow.
 POP PSW  Get char back.
 PUSH PSW
 CPI 0DH  CR?
 JNZ PUTC2  Nope.  That's all.
PUTFL LDA COFILE  Flush the buffer.
 LHLD PUTPTR
 LXI D,PUTBUF
 CALL DSUB  HL= #chars in buffer.
 MOV B,H
 MOV C,L  Tranfer count.
 CALL SYS
 DB WBLOP
 JMP PTERR
 LXI H,PUTBUF
 SHLD PUTPTR
PUTC2 POP PSW  Return.
 POP H
 POP D
 POP B
 RET
PUTC3 LXI H,PUTMSG
PUTC4 MOV A,M
 INX H
 ORA A
 JZ EXIT
 CALL CONOUT
 JMP PUTC4
PUTMSG ASC /PUTCHR: output buffer overflow./
 DW 0A0DH
 DB 0
 JMP EXIT
*
PUTPTR DW PUTBUF  Next available space.
PUTBUF DS 72  Line width.
PUTEND EQU $
*
*  HEX prints A as a two-character hexadecimal number.
*  PUTCHR is used for output.  No registers or flags
*  are changed on return.
*
HEX PUSH PSW
 ANI 0F0H  Get most significant digit.
 RRC
 RRC
 RRC
 RRC
 CALL HEX00  Print it.
 POP PSW
 PUSH PSW
 ANI 0FH  Get least significant digit.
 CALL HEX00  Print it.
 POP PSW
 RET
HEX00 CPI 10  Is digit < 10?
 JM HEX01
 ADI 7  No.  Use letters.
HEX01 ADI 48  Translate to ascii.
 CALL PUTCHR  Print it.
 RET
*
*  DSUB is just like the DAD instruction except that it
*  subtracts DE from HL instead of adding it.  Only HL
*  is changed.  Flags are returned as they were.
*
DSUB PUSH PSW
 PUSH D
 MOV A,D  First set D=-D (two's complement).
 CMA
 MOV D,A
 MOV A,E
 CMA
 MOV E,A
 INX D
 DAD D  Add HL to -D.
 POP D
 POP PSW
 RET
*
*  DOUT writes the contents of HL to the COFILE as a decimal
*  number between -32768 and 32767 inclusive.  Leading zeroes
*  and + signs are not printed.
*       Calls DSUB to subtract DE from HL.
*       Calls PUTCHR for output to the COFILE.
*       All registers and flags are returned unchanged.
*
DOUT PUSH PSW
 PUSH B
 PUSH D
 PUSH H
 MVI C,0  Flag means "don't print zeroes" initially.
 MOV A,H  Find out if we have a negative number.
 ORA A
 JP DOUT0  Nope.
 CMA  Set HL=-HL (two's complement)
 MOV H,A
 MOV A,L
 CMA
 MOV L,A
 INX H
 MVI A,'-'
 CALL PUTCHR  Print the minus sign.
DOUT0 LXI D,10000  First the 10000's digit gets printed.
 CALL DOUT1
 LXI D,1000  Then the 1000's.
 CALL DOUT1
 LXI D,100  The 100's.
 CALL DOUT1
 LXI D,10
 CALL DOUT1
 MOV A,L  Get the one's digit.
 ADI 48  Make it ascii.
 CALL PUTCHR  Print it.
 POP H
 POP D
 POP B
 POP PSW
 RET
*
*  This subroutine subtracts DE from HL as many times as it
*  will go before HL becomes negative.  Then DE is added back
*  on, and the number of times it went is printed unless it
*  was zero.  If DE is set to powers of any base<=10 then this
*  routine can be used to print a hex number in that base.
*  HL is left as it was just before it went negative.
*       A,B and HL are the only registers affected.
*
DOUT1 MVI B,0  Count # of subtractions performed.
DOUT2 CALL DSUB  HL=HL-DE
 MOV A,H
 ORA A
 JM DOUT3  We're done if HL was negative.
 INR B
 JMP DOUT2
DOUT3 DAD D  Fix HL.
 MOV A,B  Get the digit.
 ORA C  If A is zero and we haven't printed anything else,
 RZ .  then don't print this zero.
 MOV A,B  Get the digit back again.
 ADI 48  Make it ascii.
 INR C  Remember that we printed something.
 CALL PUTCHR
 RET
*
*  PTERR receives a PTDOS error in reg. A, and uses the
*  error explaining utility UXOP to explain it.  It closes
*  all files and performs a reset (RESOP) back to the CI.
*     Before explaining the error, it prints the message
*  at ERRMSG to the console.
*     The name of the program which got the error is a good
*  thing to have at ERRMSG.  The message is terminated
*  by a zero byte, so no message will be printed if ERRMSG
*  itself is a zero byte.
*
PTERR STA PTER2  Save the error number for UXOP.
 MVI A,-1
 CALL SYS
 DB CAOP  Close all files.
 JMP PTEXIT  This should never happen.
 MVI A,0DH  CR
 CALL CONOUT
 MVI A,0AH  LF
 CALL CONOUT
 LXI H,ERRMSG  HL-> message.
PTER0 MOV A,M
 INX H
 ORA A
 JZ PTER1  Done with message.
 CALL CONOUT
 JMP PTER0
PTER1 LXI H,-1  No second line message.
 MVI A,88H  Indicates user return & no CR before "ERROR:".
 CALL UTIL
 DB UXOP
 JMP PTEXIT  An error???
 DB -1  Not a command error.
PTER2 DB 0  The error number.
PTEXIT CALL SYS  UTIL returns here.
 DB RESOP
*
* Variables, flags, etc.:
*   
FNAM ASC "SYSGLOBL/"
UNIT DB NONE
 DB 0  end of file name
FNUM DB 0  Number of file when opened.
EXTRA DB YES  Flag so 'no' and 'on' will have an extra blank.
LONG DB NO  Whether we should print lots of stuff.
GLOBAL DW 0  Pointer to the data to be printed.
LOWAD DW 0  Lowest address available to system.
MINAD DW 0  Lowest address in use.
ERRMSG ASC /SYST/  Printed by PTERR in emergencies.
 DB 0
 DS 50
STACK DS 1  The stack.
*   
 END