*
 ORG 100H
 XEQ $
*
*
*  DATE:S   Allows user to enter the date on Bootup
*
*
 copy nptdefs
*
CHCR EQU 0DH  A carriage return
CHSLSH EQU '/'  A slash
CHDEL EQU 7FH
*
START LXI B,MES1
 CALL PRINT
*
 LXI H,BUFFER  Point to the buffer
*
*
* Get the input
*
*
LOOP CALL IN
 ANI 7FH
 CPI CHCR
 JZ ANALYZE
 CPI CHDEL
 JZ DELETE
*
 MOV B,A  If the buffer is full, wait for delete or CR
 MOV A,M
 ORA A
 JZ LOOP
 MOV A,B
*
 CPI CHSLSH  A slash is okay
 JZ OK
 CPI 30H  Nothing else is allowed except numbers
 JC LOOP
 CPI 3AH
 JNC LOOP
*
OK MOV M,A
 INX H
 CALL OUT
 JMP LOOP
*
*
* Analyze the date, and if none was entered, use the old date
*
ANALYZE MVI M,0  If nothing is in the buffer, then use old date
*
 LHLD SYSGLO
 LXI D,GLDAT
 DAD D
 XCHG
*
 LXI H,BUFFER
 MOV A,M
 ORA A
 JZ OLDATE
 CPI CHSLSH
 JZ OLDATE
*
ANA0 MVI B,0
 MOV A,M
 ORA A
 JZ EXIT
*
ANA1 ANI 0FH
 ORA B
 MOV B,A
 INX H
 MOV A,M
 CPI CHSLSH
 MOV A,B
 JZ ANA2
 MOV A,M
 INX H
*
 ANI 0FH
 PUSH PSW
 MOV A,B
 RRC
 RRC
 RRC
 RRC
 ANI 0F0H
 MOV B,A
 POP PSW
 ORA B
*
ANA2 STAX D
 INX D
 MOV A,M
 CPI CHSLSH
 INX H
 JZ ANA0
*
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
*
**********     Set date on disk
*
 LXI B,DATEP
 CALL OPMOV  OPEN SYSBLOBL, AND MOVE TO DATE
 CALL REATR  REATTRIBUTE IT SO IT MAY BE WRITTEN ON
 PUSH H
 LHLD SYSGLO
 LXI D,GLDAT
 DAD D
 XCHG
 POP H
 LXI B,3
 LDA SGNUM
 CALL SYS
 DB WBLOP   WRITE DATE INTO FILE
 CALL ER0
 CALL CLOSE  CLOSE FILE
 JMP EXIT
*
*
*      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 WRITE  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
*
WRITE LDAX D  PRINT MESSAGE AT DE ON CONSOLE
 ORA A
 RZ .
 CALL CONOUT
 INX D
 JMP WRITE
*
*
SMES1 ASC "DATE ERROR: "
 DB 0
ARROW ASC " -> "
 DB 0
CRLF DDB 0D0AH
 DB 0
*
*
****************************************
*
*          STORAGE  AREA
*
SGNUM DB -1  FILE NUMBER OF SYSGLOBL
SGNAM ASC "SYSGLOBL"  NAME NEEDED TO OPEN IT
 DB 0
*
*
****************************************
*  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
*
*
* Use the old date
*
*
OLDATE MOV A,L  If a date was entered, then exit now
 CPI >BUFFER
 JNZ EXIT
*
 LXI B,MES2  Otherwise, tell the date that will be used
 CALL PRINT
*
 LDAX D  Output the month
 CALL PRHEX
 MVI A,CHSLSH  Output a "/"
 CALL OUT
 INX D
 LDAX D  Output the day
 CALL PRHEX
 MVI A,CHSLSH  Now a "/"
 CALL OUT
 INX D
 LDAX D  And finally, output the year
 CALL PRHEX
*
*
* The exit routine
*
*
EXIT CALL SYS
 DB 0DH
*
*
* Delete a character in the buffer
*
*
DELETE DCX H
 MOV A,M
 ORA A
 INX H
 JZ LOOP
*
 DCX H
 MVI A,CHDEL-20H
 CALL OUT
 JMP LOOP
*
*
* Print a hex value
*
*
PRHEX MOV B,A  Print the ASCII version of the value in A
 RLC
 RLC
 RLC
 RLC
 CALL PRHX1
*
 MOV A,B
*
PRHX1 ANI 0FH
 ADI 30H
 JMP OUT
*
*
*  Print the message
*
*
PRINT LDAX B  Move character into A
 ORA A  If it is a zero, we are done
 RZ .  Return if done
 CALL OUT  Put character to screen
 INX B  Point to next character
 JMP PRINT  Go and print it
*
*
* Input and output routines
*
*
IN PUSH B
 PUSH D
 PUSH H
 CALL CONIN
 POP H
 POP D
 POP B
 RET
*
OUT PUSH B
 PUSH D
 PUSH H
 CALL CONOUT
 POP H
 POP D
 POP B
 RET .
*
MES1 ASCZ "Enter today's date (MM/DD/YY): "
MES2 DB CHCR
 ASCZ "The system date will be used: "
*
 DB 0  A small buffer for the date
BUFFER ASC "00/00/00"
 DB 0
*
 END