*
*
*                <<<   SET COMMAND FOR 1.4   >>>
*
*
*
*   VERSION  9/6/77
*
*     ARGUMENTS ALLOWED:  (SET TABLE FOR WHAT THEY DO)
*
*        DU=#    SY=#    PR=#    NU=#    BU=#
*        DA=#/#/#    DD=#/#/#    NA=NAME    EF=#
*        WC=#    RC=#    SC=#    SW={+ or -}ELUHVB or R
*     WHERE # IS A NUMBER, AND NAME IS AN 8-LETTER NAME
*
 COPY NPTDEFS
 ORG CXBUF+17  ERROR STUFF GOES BEFORE TO BE SAFE
 XEQ SOPNG
*
*     /////    DIRECT REFERENCE TO SYSTEM    /////
*
LNFCB EQU 34  LENGTH OF FCB'S ////
FCBAT EQU 3  POSITION IN FCB OF ATTRIBUTES ////
GLOBG EQU 5*34  SIZE OF GARBAGE AT START OF SYSGLOBL ////
*
DATEP EQU GLOBG+GLDAT  OFFSET INTO SYSGLOBL OF DATE
*
*
*
*****************   START OF CODE   ***************
*
*
SOPNG CALL LMCK  SEE IF WE'RE DONE
 LXI D,USER
 MVI A,PSOPT  GET TO DELIMITER ONLY
 CALL PSCAN
 STA DELMT
 JC ERPS  PSCAN ERROR
 JZ SOPNG  NO CHRS...LOOP OVER
*
 LXI H,USER  GET THE INPUT LINE
 LXI D,SCTAB  POINT TO VAILD COMMAND TABLE
*
*    SEARCH TABLE FOR DOUBLE CHR MATCH
*
SCSRC LDAX D  GET CHR
 ORA A  END OF TABLE
 JZ ER2  YES...ERROR
 INX D  IN CASE OF BRANCH
 CMP M  TEST FIRST CHR
 JNZ SCNXT
 INX H
 LDAX D
 CMP M  AND THE SECOND
 JZ SDISP  IF BOTH MATCH
 DCX H
*
SCNXT INX D
 INX D
 INX D
 JMP SCSRC
*
*
*   DISPATCH TO OPERATION
*
SDISP INX H  FIRST SCAN TO '='
 MOV A,M
 ORA A
 JZ ER3  ERROR NO PARAM
 CPI '='
 JNZ SDISP
 INX H  ONE CHR PAST POINTS TO VALUE
 PUSH H
 XCHG
 INX H
 MOV A,M  GET DISPATCH ADDRESS
 INX H
 MOV H,M  HIGH ORDER
 MOV L,A  LOW  "   "
 XTHL .  GET BACK SCAN LINE
 RET .  AND GO!!!
*
*
LMCK LDA DELMT
 CPI ';'
 JZ RETRN
 CPI 0DH
 RNZ
*
RETRN CALL SYS
 DB RETOP
*
****************************************
*
*      VALID COMMAND TABLE
*
SCTAB ASC "DU"  SET DUNIT
 DW SUNIT
*
 ASC "SY"  SET NUMBER OF SYSTEM FILES
 DW STSYS
*
 ASC "PR"  USER MEMORY PROTECT
 DW SPROT
*
 ASC "NU"  NUMBER OF NULLS
 DW SNULL
*
 ASC "BU"  THE LOWAD OF THE BUFFER
 DW SBUF
*
 ASC "DA"  THE DATE  (ONLY CHANGES MEMORY)
 DW SDATE
*
 ASC "DD"
 DW SDDAT  THE DISK DATE  (CHANGES DATE ON DISK)
*
 ASC "NA"  THE DISK NAME  (ONLY CHANGES MEMORY)
 DW SNAME
*
 ASC "EF"  ECHO FILE
 DW SECHO
*
 ASC "WC"  WRITE CHARACTER ROUTINE POINTER
 DW SWCH
*
 ASC "RC"  READ CHARACTER ROUTINE POINTER
 DW SRCH
*
 ASC "SC"  TEST CHARACTER ROUTINE POINTER
 DW SSCH
*
 ASC "SW"  THE SWITCHES
 DW SSWCH
*
 DB 0   END OF TABLE
*
****************************************
*
*   GENERAL PURPOSE VALUE GETTING ROUTINES
*
VALU8 CALL VAL16
 MOV A,D  TEST HIGH ORDER
 ORA A
 JNZ ER5  VALUE OUT OF RANGE
 MOV A,E
 RET
*
*
VAL16 MVI A,PSV+40H
 PUSH B
 CALL PSCAN
 POP B
 JC ERPS
 JZ ER4
 RET
*
*
VAUNT CALL VALU8
 CPI 8
 RC
 JMP ER5  VALUE OUT OF RANGE
*
****************************************
*
*              OPERATORS
*
*
**********     SET DEFAULT UNIT
*
SUNIT CALL VAUNT  GET <8 VALUE
 LXI B,GLUNI
*
SET8 LHLD SYSGLO
 DAD B
 MOV M,A
 JMP SOPNG  LOOP AROUND
*
**********     SET NUMBER OF PERMENTLY OPEN FILES
*
STSYS CALL VAUNT
 CPI 3
 CC ER5
 LXI B,GLPRM
 JMP SET8
*
**********   SET OUTPUT NULL COUNT
*
SNULL CALL VALU8
 LXI B,GLNCT
 JMP SET8
*
**********     SET ECHO FILE
*
SECHO CALL VALU8
 LXI B,GLECF
 JMP SET8
*
**********     SET SWITCH FLAGS
*
SSWCH MOV A,M  GET CHAR
 ORA A
 JZ SOPNG
 INX H
 CPI '+'
 JZ SSWCH  LOOP ON PLUS
 DCX H
 CPI '-'
 PUSH PSW  SAVE ZERO FLAG (SET IF '-')
 JNZ SSWCA
 INX H  SCAN PAST THE MINUS
*
SSWCA MOV A,M
 ORA A
 JZ ER4
 LXI D,SWTAB  SWITCH TABLE
*
SSWC1 LDAX D
 ORA A
 JZ ER4  HIT END OF TABLE
 CMP M  MATCH?
 INX D
 JZ SSWC2  YES
 INX D
 INX D
 JMP SSWC1
*
*
SSWC2 POP PSW  RESTORE ZERO FLAG (SET IF '-' OPTION)
 MVI A,0
 JZ SSWC3
 INR A  TURN IT ON
*
SSWC3  PUSH H  SAVE SCAN ADDRESS
 XCHG .
 MOV E,M  GET SWITCH ADDRESS FROM TABLE
 INX H
 MOV D,M
 LHLD SYSGLO
 DAD D  POINT TO SELECTED SWITCH
 MOV M,A  SAVE IT
 POP H  RESTORE SCAN ADDRESS
 INX H
 JMP SSWCH  GO BACK FOR MORE SWITCH SETTINGS
*
*
*      SWITCH  TABLE
*
SWTAB DB 'E'  ECHO DISABLE FLAG
 DW GLECH
 DB 'L'  DISK WRITE LOCK FLAG
 DW GLLOK
 DB 'U'  UPSHIFT ASCII I/O FLAG
 DW GLUPS
 DB 'H'  VERBOSE DISABLE FLAG
 DW GLVRB  <<---- THIS BYTE CHANGED FOR FIXED VERSION
 DB 'V'  DISK READ-BACK-CHECK AFTER WRITE FLAG
 DW GLRBC
 DB 'B'  BINARY I/O ON CONSOLE FLAG
 DW GLBIO  <<----- NEW VERSION CHANGE
 DB 'R'  DISK READ BEFORE WRITE FLAG
 DW GLRBW
 DB 0  END OF TABLE
*
**********     SET THE LOWEST UNPROTECTED ADDRESS
*
SPROT LXI B,GLPRO
SET16 CALL VAL16
SCON LHLD SYSGLO
 DAD B
 MOV M,E  MOVE IN THE VALUE
 INX H
 MOV M,D
 JMP SOPNG  AND LOOP
*
*
**********     SET LOWEST BUFFER ADDRESS
*
SBUF CALL VAL16  GET 16 BIT VALUE
 MOV A,D
 CPI 90H
 JC SBUF1
 JNZ ER5
 MOV A,E
 ORA A
 JNZ ER5  VALUE OUT OF RANGE
SBUF1 LXI B,GLLOW
 JMP SCON
*
*
**********     SET WRITE CHARACTER ROUTINE POINTER
*
SWCH LXI B,GLWCH
 JMP SET16
*
*
**********     SET READ CHARACTER ROUTINE POINTER
*
SRCH LXI B,GLRCH
 JMP SET16
*
*
**********     SET TEST CHARACTER ROUTINE POINTER
*
SSCH LXI B,GLTCH
 JMP SET16
*
**********     SET NAME
*
SNAME LXI B,GLNAM
 XCHG .
 LHLD SYSGLO
 DAD B
 MVI C,8
*
SNAM1 LDAX D
SNAM2 MOV M,A
 INX H
 INX D
 DCR C
 JZ SOPNG
 ORA A
 JNZ SNAM1
 JMP SNAM2
*
*
**********     SET DATE
*
SDATE CALL DATE  GET DATE INTO DABUF
 LXI D,DABUF  COPY IT INTO GLOBOL AREA
 LHLD SYSGLO
 LXI B,GLDATE
 DAD B
 LDAX D
 MOV M,A
 INX H
 INX D
 LDAX D
 MOV M,A
 INX H
 INX D
 LDAX D
 MOV M,A
 JMP SOPNG
*
*
**********     SET  DISK  DATE
*
SDDAT CALL DATE  GET DATE INTO DABUF
 LXI B,DATEP
 CALL OPMOV  OPEN SYSBLOBL, AND MOVE TO DATE
 CALL REATR  REATTRIBUTE IT SO IT MAY BE WRITTEN ON
 LXI D,DABUF
 LXI B,3
 LDA SGNUM
 CALL SYS
 DB WBLOP   WRITE DATE INTO FILE
 CALL ER0
 CALL CLOSE  CLOSE FILE
 JMP SOPNG
*
*
****************************************
*
*        GET DATE INTO DABUF
*
DATE MVI B,3
 LXI D,DABUF
*
DATE1 XRA A
 CALL GETDG  GET DECIMAL DIGIT
 JC ER5  NON-DIGIT
 CALL GETDG  GET 2ND DECIMAL DIGIT
 STAX D
 INX D
 DCR B
 JZ DATE2
 INX H  MOVE OVER DATE FIELD SEPERATOR
 JMP DATE1
*
*
DATE2 MOV A,M  CHECK FOR GARBAGE AT END
 ORA A
 JNZ ER5  VALUE ERROR
 RET
*
*
*   GET DECIMAL DIGIT
*
GETDG MOV C,A  SAVE OLD VALUE
 MOV A,M  GET CHAR
 ORA A
 JZ ER5  IF ZERO-ERROR
 CPI '0'  REMOVE ASCII BIAS
 JC GETD1  IF FIELD SEPERATOR-HANDLE IT
 MOV A,C  ELSE, ROTATE OLD VALUE BY 4
 RLC
 RLC
 RLC
 RLC
 MOV C,A
 MOV A,M
 SBI '0'  RE-GET NEW CHARACTER
 CPI 10
 JNC ER5  VALUE ERROR
 INX H
 ORA C  OR IN OLD VALUE
 RET .  RETURN WITH CARRY CLEAR
*
*
GETD1 MOV A,C  HIT NON-DIGIT, SET CARRY
 STC .  AND RETURN WITH JUST OLD VALUE
 RET
*
*
********************
*
*      OPEN SYSGLOBL AND SPACE IT BY B
*
OPMOV PUSH B  SAVE SPACE VALUE
 LXI D,SGNAM  POINT TO "SYSGLOBL"
 LXI H,0  STATIC BUFFER IN SYS AREA
 CALL SYS
 DB OPEOP  OPEN IT
 CALL ER0
 STA SGNUM  SAVE FILE NUMBER
*
 POP B  GET DISTANCE OF SPACE
 MVI D,1
 CALL SYS
 DB SPAOP
 CALL ER0
 RET .
*
********************
*
*        CLOSE  SYSGLOBL
*
CLOSE LDA SGNUM
 INR A  IS IT OPEN?
 RZ .  NO
 DCR A  YES
 CALL SYS
 DB CLOOP
 CALL ER0
 RET .
*
********************
*
*          REATTRIBUTE SYSGLOBL
*
REATR LHLD SYSGLO  MOVE TO FCB BASE
 LXI D,GLFCB
 DAD D
 MOV E,M
 INX H
 MOV D,M
 XCHG .
 LDA SGNUM  MOVE TO THE PROPER FCB
*
REAT1 LXI D,LNFCB
 DAD D
 DCR A
 JNZ REAT1
 LXI D,FCBAT  MOVE TO ATTRIBUTES
 DAD D
 MVI M,0  ZAP THEM
 RET
*
*
*****************************************
*
*          ERROR  HANDLING
*
ERPS MOV A,E  HANDLE PSCAN ERRORS
 ORA A
 JNZ ERPS1
 MVI A,ERSYN  PSCAN GAVE 0 ERROR, CHANGE TO SYNTAX ERROR
*
ERPS1 STA ERCOD
 MVI A,-1
 STA CMCOD
 LXI D,SMES2
 CALL PRINT  PRINT 'SET'
 MVI A,8  DON'T PRINT START CR, RESET WHEN DONE.
 LXI H,-1
 JMP UTCALL
*
*
 DB WBLOP  HANDLE WB ERRORS
ERWB CALL ER0
*
*
ER0 STA ERCOD  HANDLE CALL SYS ERRORS
 POP H
 DCX H
 DCX H
 DCX H
 DCX H
 MOV A,M
 STA CMCOD
 MVI A,2  PRINT "CALLED FROM", RESET
 LXI H,SMES2
 JMP UTCAL
*
*
ER2 LXI H,MSG2
 JMP ERROR
ER3 LXI H,MSG3
 JMP ERROR
ER4 LXI H,MSG4
 JMP ERROR
ER5 LXI H,MSG5
 JMP ERROR
*
*
ERROR LXI D,SMES1  HANDLE ERRORS LOCAL TO SET
 CALL PRINT  PRINT "SET ERROR"
 XCHG .
 CALL PRINT  PRINT ERROR MESSAGE
 LXI D,ARROW
 CALL PRINT  PRINT ARROW (" -> ")
 LXI D,USER
 CALL PRINT  PRINT INPUT BUFFER
 LXI D,CRLF
 CALL PRINT  PRINT CR/LF
 CALL SYS
 DB RESOP  RESET TO CI
*
*
*
PRINT LDAX D  PRINT MESSAGE AT DE ON CONSOLE
 ORA A
 RZ .
 CALL CONOUT
 INX D
 JMP PRINT
*
*
SMES1 ASC "SET ERROR: "
 DB 0
ARROW ASC " -> "
 DB 0
CRLF DDB 0D0AH
 DB 0
*
MSG2 ASC "INVALID NAME"
 DB 0
MSG3 ASC "MISSING '='"
 DB 0
MSG4 ASC "MISSING VALUE"
 DB 0
MSG5 ASC "VALUE OUT OF RANGE"
 DB 0
*
****************************************
*
*          STORAGE  AREA
*
DELMT DB 0
DABUF DS 3
USER DS 20  BUFFER USED FOR PSCAN ARGUMENTS.
SGNUM DB -1  FILE NUMBER OF SYSGLOBL
SGNAM ASC "SYSGLOBL"  NAME NEEDED TO OPEN IT
 DB 0
*
*
****************************************
 ORG CXBUF  WANT BELOW TO BE SAFE FROM UXOP
*
*  NOTE: IF THIS BLOCK LENGTHENED, CHANGE MAIN ORG
*
UTCALL CALL UTIL  PRINT ERROR MESSAGE
 DB UXOP
 JMP ABORT  SHOULD NOT RETURN, BUT IN CASE IT DOES
CMCOD DB -1  COMMAND CODE NEEDED FOR UTIL CALL
ERCOD DB -1  ERROR CODE NEEDED FOR UTIL CALL
*
ABORT CALL SYS  ABORT IF UTIL CALL RETURNS
 DB ABTOP
*
SMES2 ASC "SET"  CALL TO UTIL WILL PRINT CALLED FROM 'SET'
 DB 0
*
****************************************
*
 END
*