0000 *
0001 *
0002  COPY NPTDEFS
0003 *
0004 *
0005  ORG CXBUF
0006  XEQ EXC
0007 *
0008 *
0009 *
0010 *          < ERROR UTILITY CALLING ROUTINE >
0011 *
0012 *      VERSION 1.4.0   MAY 28, 1977   S. DOMPIER
0013 *
0014 *           RESIDES IN TOP OF CXBUF (OLBUF)
0015 *
0016 *
0017 *  CALLING PROGRAM MUST SET:
0018 *
0019 *
0020 * 1.)  OCODE EQU <COMMAND OPERATION CODE>
0021 *
0022 * 2.)  REG A:  ERROR UTILITY MESSAGE CODE
0023 *
0024 * 3.)  REG B:  < AS BELOW >
0025 *
0026 * 4.)  REG HL: < AS BELOW >
0027 *
0028 *
0029 *  REG B HAS OPTIONS:
0030 *
0031 *  BIT 7: ACTION AFTER ERROR UTILITY ROUTINE
0032 *  reset: SHORT RESET  (NO FILES CLOSED)
0033 *    set: USER RETURN (FOLLOWING UTIL CALL)
0034 *
0035 *
0036 *    IF: HL = -1:  NO PRINTING
0037 *  ELSE:
0038 *
0039 *  BIT 0:
0040 *    set: VALUE IN HL TO PRINT
0041 *  reset: HL HAS STRING POINTER (DELIMIT BINARY ZERO)
0042 *
0043 * NOTE: STRING FROM HL MUST BE LOCATED IN HIGH CXBUF
0044 *       TO ALLOW UTIL TO LOAD INTO LOW CXBUF.
0045 *
0046 *  BIT 1:
0047 *    set: PRINT "CALLED FROM:" <HL VALUE> from above
0048 *                              <STRING>   from above
0049 *
0050 *
0051 *
0052 EUTIL STA ECODE  SET ERROR MESSAGE CODE
0053  MOV A,B  GET OPTIONS TO REG A (HL IS PRESET)
0054 *
0055  CALL UTIL
0056  DB UXOP
0057  JMP ABORT  <ERROR RETURN>
0058  DB OCODE  <OPERATION CODE> EQU IN MAIN PROGRAM
0059 ECODE DB 0  <ERROR MESSAGE CODE>
0060 *
0061 *  FALL THRU TO ABORT IF RETURN HERE
0062 *
0063 ABORT MVI B,OCODE  OPERATION CODE (EQU IN MAIN PRG)
0064  CALL SYS
0065  DB ABTOP
0066 *
0067 *  END OF EUTIL
0068 *
0069 *
0070 *
0071 *
0072 *     EXECUTE COMMAND FOR PTDOS 1.4
0073 *
0074 *  UPDATE:  AUG 24, 1977   S. DOMPIER
0075 *
0076 *
0077 *  FORM:  EXEC <ADDR> {, PARAMETERS }; or <cr>
0078 *
0079 *  PARAMETERS = ANY CHRS
0080 *  PARAMETER DELIMITER = ; cr  ONLY
0081 *
0082 *  PTDOS RETURN ADDRESS IS ON STACK
0083 *
0084 *
0085 *  USER PARAMETERS POINTED TO BY REG DE.
0086 *
0087 *  IF FOLLOWING PARAMETERS EXIST, THEY ARE READ INTO
0088 *  THE BUFFER USERP (MAX = 72 CHRS).  THE PARAMETERS
0089 *  ARE READ UNTIL A ';' OR <cr> IS FOUND.
0090 *  USERP RESIDES IN THE CXBUF, FOLLOWING THE EXEC CODE.
0091 *  ON ENTRY TO THE USER EXEC ADDRESS, REG  DE POINT TO
0092 *  THE FIRST BYTE OF USERP.  THIS BUFFER IS DELIMITED
0093 *  WITH A BINARY ZERO (0), WEATHER ANY PARAMETERS WERE
0094 *  READ OR NOT.
0095 *
0096 *
0097 *
0098 *
0099 OCODE EQU 0FFH  OPERATION CODE FOR ERROR UTILITY
0100 *                IN LIEU OF ANYTHING ELSE
0101 *
0102 *
0103 *
0104 *
0105 EXC XRA A  SET END OF USER BUFFER
0106  STA USERP
0107 *
0108  MVI A,PSV  GET EXEC ADDRESS
0109  LXI D,USERW
0110  CALL PSCAN
0111  JC ERR1
0112  JZ ERR1  NO CHARACTERS
0113 *
0114  XCHG
0115  SHLD EXADD  SAVE EXECUTE ADDRESS
0116 *
0117 *
0118  CPI ','  FOLLOWING PARAMETERS?
0119  JNZ CCDD  NO
0120 *
0121 *  READ USER PARAMETERS INTO USERP BUFFER
0122 *  UNTIL ';' OR CARRIAGE RETURN.
0123 *  REG DE WILL POINT TO THIS BUFFER.
0124 *  BUFFER IS DELIMITED WITH BINARY ZERO.
0125 *
0126 *
0127  LXI D,USERP-1  USER PARAMETER BUFFER
0128 *
0129 MOREP INX D

130  XRA A
0131  STAX D  DELIMITER
0132  PUSH D  SAVE USERP BUFFER ADDRESS
0133 *
0134  MVI A,PSONE  READ ONE CHARACTER
0135  CALL PSCAN

136  POP D
0137  JC ERR9   ERROR?
0138  CPI ';'
0139  JZ XDONE
0140  CPI 0DH
0141  JZ XDONE
0142  STAX D
0143  JMP MOREP
0144 *
0145 *
0146 *
0147 CCDD CALL DLMT  NO
0148  JZ XDONE  FOUND ; OR cr
0149  JMP ERR2  SYNTAX ERROR
0150 *
0151 *
0152 *
0153 DLMT CPI ';'
154  RZ
0155  CPI 0DH
0156  RET
0157 *
0158 *
0159 XDONE LHLD EXADD  GET EXECUTE ADDRESS
0160  LXI D,USERP  POINT TO USER PARAMETER BUFFER
0161  LXI B,RETN  RETURN ADDRESS
0162  PUSH B
0163  PCHL .  GO TO EXEC ADDRESS
0164 *
0165 *
0166 RETN CALL SYS  RETURN FROM USER PGM WILL COME HERE
0167  DB RETOP
0168 *
0169 *
0170 ERR1 MVI A,ERADX  ADDRESS EXPECTED
0171  DB 1
0172 ERR2 MVI A,ERSYN  SYNTAX ERROR
0173 *
0174 ERR9 LXI H,-1  REG A HAS ERROR CODE
0175  LXI B,0
0176 *
0177  JMP EUTIL
0178 *
0179 *
0180 *
0181 EXADD DS 2
0182 *
0183 USERW DS 20
0184 *
0185 *
0186 USERP DS 72  USER PARAMETERS (MAX 72) STORED HERE
0187 *            IF ANY.  DELIMITED WITH BINARY (0).
0188 *
0189  END
0190 *
0191 *