0000  TITL SETIN COMMAND"RELEASE VERSION  77.08.10
0001 *
0002 *
0003 *
0004 *         "SETIN" COMMAND FOR 1.4
0005 *
0006 IN EQU 0
0007 OUT EQU IN-1  THIS IS NOT/IN
0008 *
0009  COPY NPTDEFS
0010 *
0011 *
0012  ORG CXBUF  THIS COMMAND IS SAFE
0013  XEQ CXBUF
0014 *
0015 *
0016 SOPNT MVI A,PSOP  OPEN FILE
0017  LXI D,USER
0018  CALL PSCAN
0019  CC ERPSC
0020  CZ ERPSC
0021  STA DELMT  SAVE THE DELIMITER
0022  MOV A,D

023  ORA A
0024  CNZ ERPSC  TOO BIG
0025  MOV A,E
0026  CPI -1
0027  CZ ERPSC
0028 *
0029  STA NFNUM
0030  CALL LMCK  CHECK FOR DELIMITERS
0031  CPI ','  MUST BE!!!
0032  JNZ SNERR  SYNTAX ERROR
0033 *
0034  MVI A,8  READ CHRS TO NEXT DELIMIT
0035  LXI D,USER
0036  CALL PSCAN
0037  CC ERPSC
0038  CZ EROP1
0039  STA DELMT
0040  LDA USER  GET FIRST CHR
0041  CPI '*'  LEAVE OLD OPEN?
0042  CNZ EROPT
0043  STA OPOPT
0044  CALL LMCK  ANY RETURN HERE IS ERROR
0045  JMP EROP1
0046 *
0047 *
0048 LMCK LDA DELMT
0049  CPI ';'
0050  JZ CLOS1
0051  CPI 0DH
0052  RNZ .  MORE TO DO
0053 *
0054 *   DO THE OPERATION
0055 *
0056 CLOS1 EQU $
0057 *

058  IF IN
0059 *
0060  LXI D,GLCIF
0061  ENDF
0062 *
0063  IF OUT
0064  LXI D,GLCOF
0065  ENDF
0066 *
0067  LHLD SYSGLO

068  DAD D
0069  MOV A,M  GET OLD NUMBER
0070  PUSH PSW
0071  LDA NFNUM
0072  MOV M,A  SET IN THE NEW
0073  POP PSW
0074  STA NFNUM  SAVE THE OLD
0075 *
0076 *
0077 *  THE NEW ONE IS STORED, SEE IF THE OLD SHOULD BE CLOSED
0078 *
0079  LDA OPOPT  GET OPTION FLAG
0080  ORA A  TEST
0081  JNZ SRET1  IT WAS SET
0082 *
0083 *   CLOSE THE OLD CI FILE
0084 *
0085  LDA NFNUM
0086  CALL SYS
0087  DB CLOOP
0088  CALL ERSYM   ERROR RETURN
0089 *
0090 *  RETURN TO SYSTEM
0091 *
0092 SRET1 CALL SYS
0093  DB RETOP
0094 *
0095 *  ERROR HANDLERS
0096 *
0097 SNERR XRA A
0098  CALL ERSYM  THIS SHOULD NEVER HAPPEN
0099 *
0100 EROP1 MVI A,48
0101  JMP EROP
0102 EROPT MVI A,54
0103 EROP LXI H,EOPT
0104  STA ERBYT  THE ERROR BYTE
0105  JMP ERRPT
0106 *
0107 *
0108 ERPSC MOV A,E  ENTRY POINT FROM PSCAN ERROR

109  ORA A
0110  JM ERPS1
0111  STA ERBYT
0112 *
0113 ERPS1 LXI H,ESCAN
0114  JMP ERRPT
0115 *
0116 ERSYM POP H  HANDLE SYSTEM ERRORS
0117  STA ERBYT
0118  JMP ERRPT
0119 *
0124 *
0125 *
0127 *
0128 *  REPORT ON ERRORS
0129 *
0130 ERRPT MVI A,0  MESSAGE
0131  CALL UTIL
0132  DB UXOP
0133  CALL ERABT IF SYSTEM ERROR
0134  DB 45  COMMAND CODE
0135 ERBYT DB -1  ERROR MESSAGE CODE
0136 *
0137 ERABT CALL SYS
0138  DB ABTOP
0139 *
0140 EOPT ASC "EXPECTED *"
0141  DB 0
0142 *
0143 ESCAN ASC "CALLED FROM PSCAN"
0144  DB 0
0145 *
0120 OPOPT DB 0   LEAVE FILE OPEN OPTION
0121 DELMT DB 0
0122 NFNUM DB 0
0123 USER DS 20
0146 *
0147  END
0148 *