*
*
*                     CONFIGR
*
*                                                 TIM FREDENBURG
*                                                         9/1/77
*
*
*           CHANGE PARAMETERS IN THE SYSGLOBL FILE
*
*
*                        DEFINITIONS
*
 COPY NPTDEFS
*
DEBUG EQU 0  1 TO HAVE CALLED FROM PRINT AN ADDRESS
NOTDEBUG EQU 1-DEBUG  OR 0 TO PRINT "CALLED FROM CONFIG".
*
*             /// SYSTEM REFERENCES ///
FCBLEN EQU 34  LENGTH OF AN FCB.
FCBS EQU FCBLEN*5  SPACE 'FCBS' TO PASS \F\C\BS IN ^SYSGLOBL.
ATRBPOS EQU 3  POSITION OF ATTRIBUTES IN AN ^FCB.
BKSZPOS EQU 1  POSITION OF BLOCK SIZE IN AN ^FCB.
BFADPOS EQU 11  POSITION OF BUFFER ADDRESS IN AN ^FCB.
LOWMAX EQU 9000H  MAX VALUE FOR LOWEST ADDRESS OF BUFFER AREA
*
CR EQU 0DH  CARRIAGE RETURN
LF EQU 0AH  LINE FEED
RUBOUT EQU 7FH  DELETE CHARACTER
BACKCHAR EQU 5FH  BACK-ARROW OR UNDERLINE
CNTLX EQU 018H  CONTROL-X; ILLEGAL IN PASSWORDS.
*
*
*
 ORG 100H
 XEQ 100H
*
*
 LXI SP,STKEND  INITIALIZE STACK POINTER TO INTERNAL STACK.
 CALL TRAPSAVE  SAVE OLD VALUES OF ERROR TRAPS.
 CALL TRAPINIT  INITIALIZE ERROR TRAPS TO RETURN TO CONFIG.
 CALL CRLF  START WITH A BLANK LINE.
*
*
*  SCAN OFF FIRST ARGUMENT - EITHER UNIT OR PASSWORD
*
 CALL ZERO  FIRST CLEAR THE PSCAN BUFFER.
 MVI A,PSOPT  PSCAN OP: READ TO A DELIMETER.
 LXI D,PBUFF  BUFFER FOR PSCAN.
 CALL PSCAN
 CC PSCER  PSCAN ERROR.
 JZ NOARGS  IF NO ARGUMENT THEN NO PASSWORD
 CPI ';'  CHECK IF WE HIT END OF THE COMMAND.
 JZ DEFUNIT  ONLY 1 ARGUMENT MUST BE PASSWORD, SO DEFAULT UNIT.
 CPI CR
 JZ DEFUNIT
 CPI 0
 JZ DEFUNIT
 CPI ','  MUST BE COMMA BETWEEN ARGUMENTS.
 JNZ ARGERROR  COMMA MUST SEPARATE ARGUMENTS.
*
 LDA PBUFF  SINCE THERE ARE 2 ARGUMENTS MAKE SURE THAT
 CPI '/'  THE FIRST IS A UNIT.
 JNZ ARGERROR  OH-OH.
 LDA PBUFF+1  GET UNIT NUMBER (ASCII).
 STA UNIT  STORE INTO SYSGLOBL NAME.
*
*  SCAN SECOND NAME - MUST BE PASSWORD
*
 MVI A,PSOPT  SCAN TO A DELIMETER.
 LXI D,PBUFF  PSCAN BUFFER.
 CALL PSCAN
 CC PSCER  PSCAN FOUND AN ERROR.
 CZ ZERO  NO CHARS MEANS NO PASSWORD.
 CPI ','  CHECK IF THERE ARE FURTHER ARGUMENTS.
 JZ ARGERROR  THERE SHOULDN'T BE.
 JMP COMPARE  GO COMPARE INPUT PASSWORD TO ACTUAL.
*
*
NOARGS CALL ZERO  NO PASSWORD, DEFAULT UNIT.
*
DEFUNIT LXI D,GLUNI  GET DEFAULT UNIT FROM GLOBAL AREA.
 CALL SYSGET  GET 2 BYTES INTO HL
 MOV A,L  BUT ONLY USE THE LOW ONE.
 ADI '0'  ADD IN ASCII OFFSET FOR NAME.
 STA UNIT  PUT IT INTO SYSGLOBL NAME.
*
*
COMPARE CALL SYSOPEN  OPEN THE ^SYSGLOBL FILE.
 LXI B,FCBS+GLPAS  GO GET ACTUAL PASSWORD.
 LXI D,8  READ 8 CHARS
 CALL READ  FROM ^SYSGLOBL.
*  NOW COMPARE
 MVI C,8  COUNT FOR LOOP; PASSWORDS HAVE 8 CHARACTERS.
 LXI D,PBUFF  LOCATION OF INPUT PASSWORD.
 LXI H,BUFFER  LOCATION OF ACTUAL PASSWORD.
*
COMPLOOP LDAX D  GET A CHAR FORM INPUT PASSWORD.
 CMP M  COMPARE WITH CORRESPONDING CHAR FROM ACTUAL PASSWORD.
 JNZ BADPASSW  IF NOT EQUAL THEN WRONG PASSWORD.
 INX H  MOVE TO THE NEXT CHARS.
 INX D
 DCR C  CHARACTER COUNT.
 JNZ COMPLOOP  IF COUNT = 0 THEN PASSWORDS MATCHED.
*
MATCH EQU $
*
*  PRINT HEADING WITH DISK NAME
*
 LXI B,FCBS+GLNAM  GET NAME
 LXI D,8  OF 8 CHARACTERS
 CALL READ  FROM ^SYSGLOBL.
 LXI D,TOPMESG  PRINT NICE MESSAGE.
 CALL PRINT
 LXI D,BUFFER  PRINT NAME.
 CALL MESG
 CALL CRLF  FOLLOW WITH A BLANK LINE.
 JMP PARAMS  GO READ NEW SYSTEM PARAMETERS.
*
TOPMESG ASC "New configuration for system on disk "
 DB 0
*
*
PARAMS EQU $
*
 CALL NAME  DISK NAME.
 CALL PASSWORD
 CALL MAXUNIT  MAXIMUM NUMBER OF DISK UNITS.
 CALL UMEMPROT  USER MEMORY PROTECT.
 CALL READCHAR
 CALL WRITCHAR
 CALL TESTCHAR
 CALL BUFFLOWAD
 CALL INTERRUPT
 CALL ECHO
 CALL DISKWRITE
 CALL UPSHIFT
 CALL READBACK
 CALL BINARYIO
 CALL RDBEFOREWR
 CALL VERBOSE
 CALL MAXOPEN
*
*
RETURN CALL SYSCLOSE  CLOSE ^SYSGLOBL.
 CALL TRAPRESET  PUT ERROR TRAPS BACK.
 CALL SYS  GO HOME.
 DB RETOP
*
*
*
*
*
*
*
*
*  ^DISK ^NAME
*
NAME LXI D,NAMEMESG  TELL THEM IT'S A NAME.
 CALL PRINT
 LXI B,FCBS+GLNAM  GO GET NAME.
 LXI D,8  8 CHARS LONG.
 CALL READ
 LXI D,BUFFER  PRINT NAME.
 CALL PRINT
 CALL INPUT  GET NEW NAME, IF ANY.
 JC NAME  IF INPUT ERROR, START OVER.
 JZ NAMEND  IF NAME IS NOT TO BE CHANGED, SKIP TO END.
*
*  CHECK FOR CONTROL CHARACTERS IN INPUT NAME
 MVI C,9  ALSO CHECK NAME LENGTH; 9 OR MORE CHARS IS ERROR.
 LXI H,BUFFER  WHERE NAME IS.
*
NAMELOOP MOV A,M  GET A CHAR OF THE NAME.
 ORA A  TEST FOR END OF NAME.
 JZ NAMEOK  IF SO THEN THE NAME WAS ALL RIGHT.
 CPI ' '  TEST FOR CONTROL CHARACTER.
 JC NAMERROR  IF SO THEN NAME IS IN ERROR.
 INX H  MOVE TO NEXT CHAR.
 DCR C
 JNZ NAMELOOP  IF THAT WASN'T THE NINTH CHAR, LOOP BACK
*
NAMERROR CALL ERROR  PRINT " ERROR"
 JMP NAME  AND TRY AGAIN.
*
NAMEMESG ASC "Disk name: "
 DB 0
*
*
NAMEOK MOV A,C  CHECK IF SOMEHOW NAME WAS NULL.
 CPI 9
 JZ NAMEND  IF SO THEN DON'T CHANGE DISK NAME.
*
 LXI B,FCBS+GLNAM  WRITE NEW NAME.
 LXI D,8  OF 8 CHARACTERS.
 CALL WRITE
*
NAMEND CALL CRLF  FINISH WITH CRLF IF NAME WRITTEN OR NOT.
 RET .  ALL DONE.
*
*
*
*
*  PASSWORD
*
PASSWORD LXI D,PASWQUEST  SEE IF THEY REALLY WANT TO CHANGE IT.
 CALL PRINT
 CALL CONIN  GET THE ANSWER TO THE QUESTION.
 ANI 5FH  ZAP PARITY BIT AND UPSHIFT LETTER
 JZ RETURN  AND CHECK FOR QUIT.
 CPI 'Y'
 JNZ PASWDONE  IF NOT YES THEN ASSUME NO.
 LXI D,SPAC  MOVE OUT TO WAIT FOR PASSWORD.
 CALL PRINT
 CALL INPUT  GET THE PASSWORD.
 JC PASSWORD  ANOTHER CHANCE TO SCREW UP.
*
* CHECK FOR CNTRL-X ';' ',' ' '
*
 MVI C,9  CHAR COUNT.  IF 9TH CHAR NOT 0 THEN ERROR.
 LXI D,BUFFER  WHERE PASSWORD IS.
*
PASWCHECK LDAX D  GET A CHAR OF THE PASSWORD.
 ANI 07FH  ZAP THE PARITY BIT AND TEST FOR END OF PASSWORD,
 JZ PASWWRITE  IF SO THEN PASSWORD OK SO WRITE IT.
 CPI CNTLX  CONTROL-X NOT VALID BECAUSE OF CI.
 JZ PASWERROR
 CPI ';'  SEMI-COLON NOT VALID FOR SAME REASON.
 JZ PASWERROR
 CPI ','  AND SO GOES COMMA.
 JZ PASWERROR
 CPI ' '  AND SO GOES SPACE.
 JZ PASWERROR
 INX D  MOVE TO NEXT CHAR IN PASSWORD.
 DCR C  CHECK COUNT.
 JNZ PASWCHECK
 LXI D,OVERFMESG  TELL HIM THE PASSWORD IS TOO LONG
 CALL MESG
 JMP PASSWORD  GO TRY AGAIN.
*
PASWERROR LXI D,ILLCHAR  TELL HIM WHICH CHARS ARE ILLEGAL.
 CALL MESG
 JMP PASSWORD
*
ILLCHAR ASC "  No , ; Space or Control-X"
 DB 0
*
*
PASWWRITE LXI B,FCBS+GLPAS  GO WRITE NEW PASSWORD.
 LXI D,8
 CALL WRITE
PASWDONE CALL CRLF  FINISH LINE.
 RET
*
PASWQUEST ASC "Change password? "
 DB 0
SPAC ASC "       "
 DB 0
*
*
*
*  MAXUNIT
*
MAXUNIT LXI D,MXUNMESG  TELL HIM WHO WE ARE.
 CALL PRINT
 LXI B,FCBS+GLMXU  GO GET CURRENT MAXIMUM UNIT NUMBER.
 LXI D,1
 CALL READ
 LXI D,BUFFER  CHANGE IT TO ASCII AND PRINT IT.
 LDAX D
 ADI '0'
 STAX D
 CALL PRINT
 CALL INPUT  GET NEW MAX.
 JC MAXUNIT  SOMEBODY BLEW IT.
 JZ MXUNDONE  NO CHANGE TODAY.
 LDA BUFFER+1  MAKE SURE THAT ONLY ONE DIGIT INPUT.
 ORA A
 JNZ MXUNERROR
 LDA BUFFER  SEE IF NUMBER IS WITHIN BOUNDS.
 SUI '1'  DEASCII AT THE SAME TIME.
 JC MXUNERROR  CHAR WAS < '1'.
 INR A  MAKE IT CORRECT NUMBER.
 CPI 8+1  SHOULDN'T BE GREATER THAN 8.
 JNC MXUNERROR  IT WAS.
 STA BUFFER  PUT BACK IN BUFFER FOR WRITE.
 LXI B,FCBS+GLMXU  GO WRITE NEW MAX.
 LXI D,1
 CALL WRITE
*
MXUNDONE CALL CRLF  FINISH LINE.
 RET
*
MXUNMESG ASC "Maximum number of units: "
 DB 0
*
MXUNERROR CALL ERROR
 JMP MAXUNIT
*
*
*
*  UMEMPROT
*
UMEMPROT LXI D,MEMPMESG  PRINT WHAT THIS PARAMETER IS.
 CALL PRINT
 LXI B,FCBS+GLPRO  GET CURRENT VALUE.
 CALL DOHEXNUM  PRINT OLD VALUE, GET NEW ONE.
 JC UMEMPROT  HE DID SOMETHING WRONG.
 JZ MEMPDONE  NOT TODAY.
 LXI B,FCBS+GLPRO  GO STORE IT.
 LXI D,2
 CALL WRITE
*
MEMPDONE CALL CRLF
 RET
*
MEMPMESG ASC "User memory protect: "
 DB 0
*
*
*
*  CONSOLE READ CHARACTER ROUTINE POINTER
*
READCHAR LXI D,RCHMESG  EXPLAIN WHAT THIS PARAMETER IS.
 CALL PRINT
 LXI B,FCBS+GLRCH  GO GET PRESENT ADDRESS.
 CALL DOHEXNUM  PRINT OLD VALUE, GET NEW ONE.
 JC READCHAR  A MISTAKE.
 JZ RCHDONE  NOT THIS TIME.
 LXI B,FCBS+GLRCH  WRITE NEW VALUE ON DISK.
 LXI D,2
 CALL WRITE
*
RCHDONE CALL CRLF
 RET
*
RCHMESG ASC "Console read char routine addr: "
 DB 0
*
*
*
*  CONSOLE WRITE CHARACTER ROUTINE ADDRESS
*
WRITCHAR LXI D,WCHMESG  ANNOUCE US.
 CALL PRINT
 LXI B,FCBS+GLWCH  PRINT CURRENT VALUE.
 CALL DOHEXNUM  PRINT OLD VALUE, GET NEW.
 JC WRITCHAR  HE DOESN'T KNOW WHAT HE WANTS.
 JZ WCHDONE  HE DOESN'T WANT ANYTHING.
 LXI B,FCBS+GLWCH  OK, WE BELIEVE HIM.
 LXI D,2
 CALL WRITE  SAVE IT FOR POSTERITY.
*
WCHDONE CALL CRLF
 RET
*
WCHMESG ASC "Console write char routine addr: "
 DB 0
*
*
*
*  CONSOLE TEST CHARACTER READY ROUTINE ADDRESS
*
TESTCHAR LXI D,TCHMESG  SHOW OUR COLORS.
 CALL PRINT
 LXI B,FCBS+GLTCH  SHOW HIM WHAT WE'RE WORTH.
 CALL DOHEXNUM  PRINT CURRENT VALUE, ASK FOR NEW.
 JC TESTCHAR  NOPE.
 JZ TCHDONE  NOT MUCH TO SAY.
 LXI B,FCBS+GLTCH  CAME THROUGH LOUD AND CLEAR.
 LXI D,2
 CALL WRITE
*
TCHDONE CALL CRLF
 RET
*
TCHMESG ASC "Console test char ready routine addr: "
 DB 0
*
*
*
*  LOWEST ADDRESS OF BUFFER AREA
*
BUFFLOWAD LXI D,BLOWMESG  ANNOUCE US.
 CALL PRINT
 LXI B,FCBS+GLLOW  WHERE CURRENT VALUE IS.
 CALL DOHEXNUM  PRINT IT AND GET A NEW ONE.
 JC BUFFLOWAD  HUH?
 JZ BLOWDONE  AW SHUCKS.
 LHLD BUFFER  CHECK VALUE FOR LEGALITY.
 LXI D,-LOWMAX-1  MUST BE <= LOWMAX.
 DAD D
 JC BLOWERROR
*
 LHLD BUFFER  GET NEW VALUE BACK
 PUSH H  AND SAVE FOR FUTURE REFERENCE.
*
*  CHECK THAT THIS LEAVES ENOUGH BUFFER ROOM BELOW \F\C\BS.
*
 LXI B,FCBS+GLPRM  GET # OF PERMANENTLY OPEN FILES.
 LXI D,1
 CALL READ
 LXI D,FCBLEN  BUFFER ADDRESS OF LAST FILE.
 LXI H,BFADPOS
 LDA BUFFER  COUNT.
*
SCOOT DCR A  SEE IF WE ARE THERE.
 JZ LAST
 DAD D  MOVE TO THE NEXT ^FCB.
 JMP SCOOT
*
LAST MOV B,H  PUT POINTER TO BUFFER ADDR IN BC FOR READ.
 MOV C,L
 LXI D,2
 CALL READ
 LHLD BUFFER  GET THE ADDRESS.
 LXI D,-800H  LEAVE SOME EXTRA BUFFER SPACE TO USE.
 DAD D
 XCHG .  MAXIMUM LOWAD INTO DE
 POP H  GET BACK NEW VALUE.
 MOV A,E  MAKE SURE IT IS LESS.
 SUB L
 MOV A,D
 SBB H
 JC BLOWERROR
 SHLD BUFFER  SAVE NEW VALUE.
*
*  DO A MEMORY TEST TO SEE IF MEMORY IS ACTUALLY THERE.
*
 LXI D,SAFE  MAKE SURE WE DON'T TEST THE TEST ROUTINE!
 MOV A,L  SUBTRACT SAFE FROM NEW BUFFER ADDRESS
 SUB E
 MOV A,H
 SBB D
 JNC MEMCOUNT  BUFFER IS ABOVE SAFE.
 LXI H,SAFE  START TESTING FROM SAFE.
*
MEMCOUNT LXI D,LOWMAX  LAST ADDRESS TO TEST.
 MOV A,E  SUBTRACT THE ADDRESSES TO GET COUNT.
 SUB L
 MOV C,A
 MOV A,D
 SBB H
 MOV B,A
 INX B  SO COUNT IS RIGHT.
*
MEMTEST MOV A,M  GET A BYTE OF MEMORY.
 CMA .  TEST MEMORY WITH COMPLEMENTED DATA.
 MOV M,A
 CMP M  DID IT GET THERE?
 JNZ MEMERROR  NOPE.
 CMA .  PUT IT BACK RIGHT.
 MOV M,A
 CMP M  DID IT GET BACK RIGHT?
 JNZ MEMERROR
 INX H  MOVE TO NEXT LOCATION.
 DCX B
 MOV A,B  SEE IF WE ARE DONE.
 ORA C
 JNZ MEMTEST
*
SAFE EQU $  OK TO DO MEMORY TEST FROM HERE ON.
 LXI B,FCBS+GLLOW  WRITE NEW VALUE.
 LXI D,2
 CALL WRITE
*
BLOWDONE CALL CRLF
 RET
*
BLOWERROR LXI D,TOHIMESG
 CALL MESG
 JMP BUFFLOWAD
*
TOHIMESG ASC " Not enough buffer space"
 DB 0
*
BLOWMESG ASC "Lowest address of buffer area: "
 DB 0
*
*
MEMERROR LXI D,MBADMESG
 CALL PRINT
 SHLD BUFFER
 CALL HEXTOASCII
 LXI D,BUFFER
 CALL MESG
 JMP BUFFLOWAD
*
MBADMESG ASC " Memory bad at "
 DB 0
*
*
*  INTERRUPT
*
INTERRUPT LXI D,INTMESG  THE WHO I AM MESSAGE
 LXI B,FCBS+GLIF1  WHERE INTERRUPT FLAG IS.
 CALL DOSWITCH  GO PROCESS.
 RET
*
INTMESG ASC "Interrupt flag: "
 DB 0
*
*
*
*  ECHO
*
ECHO LXI D,ECHOMESG  WHO AM I?
 LXI B,FCBS+GLECH  WHERE AM I?
 CALL DOSWITCH  GO PRINT AND GRAB.
 RET
*
ECHOMESG ASC "Echo enable: "
 DB 0
*
*
*
*  DISK WRITE LOCK
*
DISKWRITE LXI D,DWRTMESG
 LXI B,FCBS+GLLOK  WHERE WE ARE.
 CALL DOSWITCH  GO!
 RET
*
DWRTMESG ASC "Disk write lock: "
 DB 0
*
*
*
*  UPSHIFT
*
UPSHIFT LXI D,UPSHMESG
 LXI B,FCBS+GLUPS
 CALL DOSWITCH
 RET
*
UPSHMESG ASC "Character upshift: "
 DB 0
*
*
*
*  READ-BACK CHECK
*
READBACK LXI D,RDBKMESG
 LXI B,FCBS+GLRBC
 CALL DOSWITCH
 RET
*
RDBKMESG ASC "Read-back check: "
 DB 0
*
*
*
*  BINARY CONSOLE I/O
*
BINARY LXI D,BINMESG
 LXI B,FCBS+GLBIO
 CALL DOSWITCH
 RET
*
BINMESG ASC "Binary console I/O: "
 DB 0
*
*
*
*  SYSTEM LOG (TO FILE SYST.LOG)
*
RDBEFOREWR LXI D,RDBFMESG
 LXI B,FCBS+GLRBW
 CALL DOSWITCH
 RET
RDBFMESG ASC "System log: "
 DB 0
*
*
*
*  VERBOSE
*
VERBOSE LXI D,VERBMESG
 LXI B,FCBS+GLVRB
 CALL DOSWITCH
 RET
VERBMESG ASC "Verbose: "
 DB 0
*
*
*
*  MAXIMUM NUMBER OF OPEN FILES
*
MAXOPEN LXI D,MXOPMESG  ANNOUNCE.
 CALL PRINT
 LXI B,FCBS+GLNFC  GET CURRENT VALUE.
 LXI D,1
 CALL READ
 LHLD BUFFER  GET THE CURRENT VALUE.
 CALL DOUT  CONVERT TO DECIMAL ASCII AND PRINT IT.
 CALL INPUT  GET HIS REACTION.
 JC MAXOPEN  HE APPEARS SOMEWHAT CONFUSED.
 JZ MXOPDONE  RATHER DISINTERESTED.
 CALL ASCDECTOHEX  MAKE HIS ANSWER INTELLIGEABLE.
 JC MXOPERROR  BAD NUMBER.
 LHLD BUFFER  GET NEW NUMBER.
 MOV A,H  TEST HIGH BYTE.
 ORA A
 JNZ TOOBIG  MUST BE ZERO.
 MOV A,L  TEST ACTUAL #.
 CPI 7  MUST BE AT LEAST 7.
 JC TOOSMALL  IT WASN'T.
 PUSH H  SAVE NEW FCB NUMBER FOR WRITING LATER.
 LXI B,FCBS+GLHI  GET TOP OF FCB AREA.
 LXI D,2
 CALL READ
 MOV C,L  PUT NEW ^FCB COUNT INTO C FOR ADD LOOP.
 LHLD BUFFER  INTO HL.
*
* CALCULATE NEW FCB BASE
*
 LXI D,-FCBLEN  SUBTRACT FCB LENGTHS UNTIL NEW FCB BASE.
*
FCBADD DAD D  MOVE DOWN TO NEXT FCB.
 JNC NOROOM  RAN OUT OF MEMORY.
 DCR C  SEE IF WE ARE DOWN TO 1ST FCB.
 JNZ FCBADD  NO, GO MOVE DOWN ANOTHER.
 PUSH H  SAVE NEW FCB BASE
 LXI B,FCBS+GLPRM  GET # OF PERMANENTLY OPEN FILES.
 LXI D,1
 CALL READ
 LDA BUFFER  INTO A FOR COUNT.
 POP H  PUT NEW FCB BASE INTO HL.
 PUSH H  SAVE IT AGAIN.
 LXI B,BKSZPOS  INITIALIZE POSITION IN SYSGLOBL POINTER.
 PUSH PSW  SAVE PERMANENTLY OPEN COUNT FOR LATER.
 INR A  FUDGE THE COUNT.
*
CKLOOP DCR A  CHECK IF WE ARE DONE CHECKING (?).
 JZ ENDCK
 PUSH PSW  SAVE CURRENT COUNT.
 PUSH B  SAVE CURRENT POSITION.
 LXI D,2  GET THIS \F\C\BS BLOCKSIZE.
 CALL READ
 LDA BUFFER  MOVE CURRENT BUFFER POINTER DOWN THAT MUCH.
 CMA .  BY COMPLEMENTING AND ADDING.
 MOV E,A  LOW BYTE.
 LDA BUFFER+1  GET HIGH BYTE
 CMA
 MOV D,A
 INX D  MAKE IT A PERFECT NEGATIVE.
 DAD D  MOVE BUFFER POINTER DOWN.
 JNC NOBUFFROOM
 POP B  MOVE ^SYSGLOBL POINTER TO NEXT ^FCB BLOCK SIZE.
 LXI D,FCBLEN  ADD IN ^FCB LENGTH.
 XCHG .  MUST USE HL FOR ADD.
 DAD B
 MOV B,H  PUT RESULT BACK INTO BC
 MOV C,L
 XCHG .  RESTORE HL.
 POP PSW  GET COUNT BACK.
 JMP CKLOOP  SEE IF ANY MORE TO DO.
*
ENDCK LXI D,-800H  MAKE SURE BUFFER IS BIG ENOUGH TO WORK IN.
 DAD D  AT LEAST 2*4C0 EXTRA BYTES.
 LXI B,FCBS+GLLOW  GET LOWEST ADDRESS OF BUFFER.
 LXI D,2
 CALL READ
 XCHG .  SAVE CURRENT BUFFER ADDRESS IN DE.
 LHLD BUFFER  GET LOWAD.
 MOV A,E  SUBTRACT AND CHECK FOR LOWAD HIGHER THAN POINTER.
 SUB L
 MOV A,D
 SBB H
 JC NOBFFROOM  BUFFER NOT BIG ENOUGH.
*
*  WRITE NEW BUFFER ADDRESSES INTO ^SYSGLOBL \F\C\BS
*
 POP PSW  GET PERMANENTLY OPEN COUNT OFF STACK
 POP H  SO THAT WE CAN GET NEW ^FCB BASE
 PUSH PSW  AND THEN PUT THE COUNT BACK.
 SHLD BUFFER  WRITE NEW ^FCB BASE OUT TO THE DISK.
 LXI B,FCBS+GLFCB
 LXI D,2
 CALL WRITE
*
*  CALCULATE AND WRITE OUT NEW BUFFER ADDRESSES
*
 LXI B,BKSZPOS  INITIALIZE ^SYSGLOBL POINTER.
 POP PSW  GET COUNT OF \F\C\BS IN ^SYSGLOBL.
 INR A  FUDGE COUNT.
*
WRLOOP DCR A  CHECK IF WE ARE DONE WRITING.
 JZ WHEW  YES, THANK HEAVENS!
 PUSH PSW  SAVE CURRENT COUNT.
 PUSH B  SAVE POINTER.
 LXI D,2  GET BLOCK SIZE OF THIS ^FCB.
 CALL READ
 LDA BUFFER  SUBTRACT IT FROM CURRENT BUFFER POINTER.
 CMA
 MOV E,A
 LDA BUFFER+1
 CMA
 MOV D,A
 INX D
 DAD D
 POP B  REFRESH ^SYSGLOBL POINTER.
 PUSH B
 XCHG .  SAVE BUFFER POINTER IN DE.
 LXI H,BFADPOS-BKSZPOS  CALCULATE POSITION OF BUFFER ADDRESS
 DAD B
 MOV B,H
 MOV C,L
 XCHG .  PUT BUFFER POINTER BACK IN HL.
 SHLD BUFFER  AND PUT IT WHERE IT CAN BE WRITTEN.
 LXI D,2  WRITE NEW BUFFER ADRESS.
 CALL WRITE
*
 POP B  GET ^SYSGLOBL POINTER BACK.
 XCHG .  SAVE BUFFER POINTER IN DE.
 LXI H,FCBLEN  MOVE TO BLOCK SIZE OF NEXT ^FCB.
 DAD B
 MOV B,H
 MOV C,L
 XCHG .  BUFFER POINTER BACK WHERE IT BELONGS.
 POP PSW  GET COUNT BACK.
 JMP WRLOOP  SEE IF ANY MORE \F\C\BS TO DO.
*
WHEW LXI B,FCBS+GLMIN  LAST ALLOCATED ADDRESS IS BUFFER ADDRESS
 LXI D,2  OF LAST PERMANENTLY OPEN FILE (STILL IN BUFFER).
 CALL WRITE
 POP H  RETRIEVE NEW ^FCB COUNT.
 SHLD BUFFER  WRITE IT OUT TO THE DISK.
 LXI B,FCBS+GLNFC
 LXI D,1
 CALL WRITE
*
MXOPDONE CALL CRLF
 RET .  THANK HEAVENS IT'S OVER.
*
*
MXOPMESG ASC "Maximum open files: "
 DB 0
*
*
NOBFFROOM POP D  GET RID OF JUNK ON STACK.
 POP D
 POP D
 LXI D,NORMMESG
 CALL MESG
 JMP MAXOPEN
*
NOBUFFROOM POP D  GET RID OF JUNK ON STACK.
 POP D
 POP D
 POP D
 POP D
 LXI D,NORMMESG
 CALL MESG
 JMP MAXOPEN
*
NORMMESG ASC " Not enough buffer space"
 DB 0
*
NOROOM POP D  GET RID OF JUNK ON THE STACK.
 LXI D,NROMMESG
 CALL MESG
 JMP MAXOPEN
*
NROMMESG ASC " Not enough memory"
 DB 0
*
TOOBIG LXI D,TBIGMESG
 CALL MESG
 JMP MAXOPEN
*
TBIGMESG ASC " Must be < 256"
 DB 0
*
*
TOOSMALL LXI D,TOSMMESG
 CALL MESG
 JMP MAXOPEN
*
TOSMMESG ASC " Must be > 6"
 DB 0
*
*
MXOPERROR CALL ERROR
 JMP MAXOPEN
*
*
*
*
*
*
*
DOHEXNUM LXI D,2  READ 2 BYTES FROM POSITION IN BC
 CALL READ
 CALL HEXTOASCII  CONVERT THEM TO ASCII.
 LXI D,BUFFER  PRINT THEM FOR ALL TO SEE.
 CALL PRINT
 CALL INPUT  GET NEW VALUE.
 RC .  ERRRRRORRRRR.
 RZ .  NO RESPONSE.
 CALL MAP  UPSHIFT CHARS.
 CALL ASCIITOHEX  MAKE INPUT STOREABLE.
 JC HEXERROR  BAD NUMBER.
 XRA A  CLEAR BOTH CARRY
 INR A  AND ZERO FLAGS
 RET .  TO INDICATE SUCCESSFUL RETURN.
*
HEXERROR CALL ERROR  PRINT ERROR MESSAGE.
 STC .  INDICATE ERROR OCCURED
 RET .  AND GO BACK.
*
*
*
*
*  DO SWITCH
*
DOSWITCH XCHG .  PUT MESSAGE ADDRESS IN HL
 SHLD MESGADDR  TO STORE IT.
 MOV H,B  PUT SPACE COUNT IN HL
 MOV L,C
 SHLD SPACOUNT  TO STORE IT.
*
DOLOOP LHLD MESGADDR  PRINT WHO THIS IS.
 XCHG
 CALL PRINT
 LHLD SPACOUNT  PRINT WHAT THIS IS.
 MOV B,H
 MOV C,L
 CALL INSWITCH  VIA SWITCH INPUT ROUTINE.
 JC DOLOOP  GOOF.
 JZ DOEND  NO CHANGE TODAY.
 LHLD SPACOUNT  REPLACE SWITCH VALUE.
 MOV B,H
 MOV C,L
 LXI D,1
 CALL WRITE
*
DOEND CALL CRLF
 RET
*
*
*
INSWITCH LXI D,1  GET OLD VALUE OF SWITCH.
 CALL READ  LOCATION IS IN BC.
 LDA BUFFER  LOOK AT SWITCH VALUE.
 ORA A
 LXI D,OFF  SET WHICH MESSAGE TO PRINT
 JZ SWPRINT  IF REALLY OFF.
 LXI D,ON  OTHERWISE.
*
SWPRINT CALL PRINT
 CALL INPUT  GET NEW SWITCH VALUE.
 RC .  INPUT ERROR.  SIGNALED BY CARRY.
 RZ .  NO CHANGE TODAY.
 CALL MAP  UPSHIFT CHARS.
 LXI H,BUFFER  CHECK NEW SWITCH VALUE.
 MOV A,M  GET 1ST CHAR
 CPI 'O'  1ST CHAR MUST BE AN O
 JNZ SWERROR
 INX H  2ND CHAR.
 MOV A,M
 CPI 'N'  MAYBE ON?
 JZ SWEND  COULD BE.
 CPI 'F'  MAYBE OFF?
 JNZ SWERROR  NEITHER.
 INX H  MUST BE AN F OR ELSE ERROR
 MOV A,M
 CPI 'F'
 JNZ SWERROR
*
SWEND INX H  BYTE AFTER SWITCH MUST BE NULL.
 MOV A,M
 ORA A
 JNZ SWERROR
 LDA BUFFER+1  FIND WHICH SWITCH.
 CPI 'F'
 MVI A,0  DON'T DISTURB FLAGS
 JZ FLAGIN
 INR A  INDICATE ON.
*
FLAGIN STA BUFFER  PUT FLAG VALUE IN BUFFER.
 INR A  CLEAR ZERO FLAG AND CARRY
 RET
*
ON ASC "On"
 DB 0
*
OFF ASC "Off"
 DB 0
*
SWERROR LXI D,SWERMESG  TELL HIM WHAT HE CAN DO.
 CALL MESG
 STC .  INDICATE ERROR.
 RET
SWERMESG ASC "  On or off"
 DB 0
*
*
*
*
*
 COPY CONFG:2S/1