************************************************
*
*  SUBROUTINES
*
*
*  ^SYSOPEN - \OPEN ^SYSGLOBL AND UNPROTECT IT.
*
SYSOPEN LXI D,SYSNAME  LOCATION OF NAME "SYSGLOBL".
 LXI H,0  STATIC BUFFERING FOR OPEN.
 CALL SYS  TRY TO OPEN FILE.
 DB OPEOP
 CALL PTDER
 STA FILENUM  STORE FILE #.
*
 LXI D,GLFCB  GET THE ^FCB BASE TO ZAP ^SYSGLOBL' S ATTRIBS.
 CALL SYSGET
 LXI D,FCBLEN  MOVE TO THE PROPER ^FCB.
 LDA FILENUM  GET NUMBER OF \F\C\BS TO SKIP.
 INR A  FUDGE IT.
*
OPENLOOP DCR A  A=0 MEANS DONE SKIPPING.
 JZ ZAPATRB
 DAD D  MOVE ANOTHER ^FCB FORWARD.
 JMP OPENLOOP
*
ZAPATRB LXI D,ATRBPOS  MOVE TO ATTRIBUTES IN ^FCB.
 DAD D
 MVI M,0  ^ZAP!!!
 RET
*
SYSNAME ASC "SYSGLOBL/"  FILE NAME FOR OPEN.
UNIT DS 1  CONFIGURE UNIT GETS STORED DIRECTLY INTO NAME.
 DB 0
*
*
*  SYSCLOSE - \TRY TO CLOSE ^SYSGLOBL
*
SYSCLOSE LDA FILENUM  GET FILE # TO CLOSE.
 CPI 0FFH  IF FILE IS NOT OPEN
 RZ .  THEN DON'T DO ANYTHING.
*
 CALL SYS  DO THE CLOSE.
 DB CLOOP
 JMP OHNO  NO ERROR SHOULD OCCUR, BUT...
 MVI A,0FFH  INDICATE FILE WAS CLOSED.
 STA FILENUM
 RET .  IF FILE WAS CLOSED, THAT'S IT.
*
OHNO LDA FILENUM  TRY TO WRITE OUT NEW DATA
 MVI D,1  BY SPACING 0 BYTES.
 LXI B,0
 CALL SYS
 DB SPAOP
 JMP ONCEMORE  STILL IN TROUBLE.
*
ONCEMORE LDA FILENUM  MAYBE IT WILL CLOSE NOW.
 CALL SYS
 DB CLOOP
 JMP GIVEUP  IF NOT NOW, NEVER.
 MVI A,0FFH  INDICATE FILE WAS CLOSED.
 STA FILENUM
 RET
*
GIVEUP CALL CRLF
 LXI D,GIVEMESG  TELL USER THAT CLOSE WAS NO GO.
 CALL MESG
 RET
*
GIVEMESG ASC "Can't close SYSGLOBL; changes may not"
 ASC " have been made."
 DB 0
*
*
*  INPUT - \READS CONSOLE INPUT UNTIL CR
*   
INPUT LXI D,BUFFER  WHERE TO READ DATA INTO.
 MVI C,10  MAXIMUM CHARACTER READ COUNT.
  MVI A,' '  PRINT A BLANK FIRST TO SEPARATE
  CALL CONOUT
*   
INLOOP CALL CONIN  GET A CHAR.
 ANI 7FH  REMOVE PARITY BIT
 JZ RETURN  AND TEST FOR QUIT.
 CPI CR  CHECK FOR INPUT DONE.
 JZ INDONE
 CPI RUBOUT  SEE IF USER WANTS TO DELETE A CHAR.
 JZ BACKUP
 DCR C  CHECK COUNT.
 JZ TOOMANY  IF MORE THAN 10 THEN TOO MANY CHARS.
 STAX D  CHAR WAS OK SO SAVE IT.
 INX D
 CALL CONOUT  ECHO IT.
 JMP INLOOP  GO BACK FOR MORE.
*   
BACKUP MVI A,10  IF NO INPUT IN BUFFER
 CMP C
 JZ INLOOP  THEN DON'T DO ANYTHING; GO GET ANOTHER CHAR.
 INR C  BACKUP THE COUNT
 DCX D  AND THE BUFFER POINTER.
 MVI A,BACKCHAR  AND THE CONSOLE.
 CALL CONOUT
 JMP INLOOP  GO GET MORE.
*   
TOOMANY LXI D,OVERFMESG  PRINT " Input too long".
 CALL MESG
 STC .  INDICATE ERROR.
 RET
*   
OVERFMESG ASC " Input too long"
 DB 0
*
INDONE XRA A  STORE 0 AT END OF INPUT; DON'T ECHO ^CR.
 STAX D
 INX D  CONINUE ZERO FILLING BUFFER
 DCR C  CHECK COUNT.
 JNZ INDONE  LOOP UNTIL BUFFER IS ZERO FILLED.
*
 LDA BUFFER  CHECK IF ANY CHARACTERS WERE INPUT.
 ORA A
 RET .  ZERO FLAG IS SET PROPERLY, CARRY IS CLEAR.
*
*
*  MAP -  UPSHIFTS ALL LOWER CASE LETTERS IN BUFFER.
*
MAP LXI D,BUFFER  WHERE CHARS ARE.
 DCX D  FUDGE ADDRESS.
*
MAPLOOP INX D  MOVE TO NEXT CHAR
 LDAX D  AND GET IT.
 ORA A  ARE WE DONE?
 RZ .  LOOKS THAT WAY.
 CPI 'a'
 JC MAPLOOP  CHAR < 'a'.
 CPI 'z'+1
 JNC MAPLOOP  CHAR > 'z'.
 ADI 'A'-'a'  MAKE UPPER CASE.
 STAX D
 JMP MAPLOOP
*
*
*  READ - \GET DATA FROM ^SYSGLOBL.
*   
READ CALL REWIND  REWIND ^SYSGLOBL.
 CALL SPACE  SPACE TO DATA WANTED; COUNT IN BC.
 MOV B,D  MOVE NUMBER OF BYTES WANTED TO BC.
 MOV C,E
 LXI D,BUFFER  READ DATA IN HERE.
 LDA FILENUM
 CALL SYS
 DB RBLOP
 CALL PTDER
 XRA A  PUT A 0 AT END OF BUFFER.
 STAX D
 RET
*
*
*  WRITE - \PUT DATA IN ^SYSGLOBL
*   
WRITE CALL REWIND  GO TO BEGINNING OF ^SYSGLOBL.
 CALL SPACE  MOVE TO WHERE DATA IS TO BE WRITTEN.
 MOV B,D  PUT # OF BYTES TO WRITE INTO BC.
 MOV C,E
 LXI D,BUFFER  WHERE THE DATA IS.
 LDA FILENUM
 CALL SYS
 DB WBLOP
 CALL PTDER
 RET
*
*
*  REWIND
*
REWIND PUSH D  SAVE DE
 MVI D,0  REWIND OP FOR SPACE.
 LDA FILENUM
 CALL SYS
 DB SPAOP
 CALL PTDER
 POP D  RESTORE DE.
 RET
*   
*
*  SPACE
*
SPACE PUSH D  PRESERVE DE
 MVI D,1  SPACE FORWARD THE AMOUNT IN BC.
 LDA FILENUM
 CALL SYS
 DB SPAOP
 CALL PTDER
 POP D  RESTORE DE.
 RET
*
*
*
*  MESG - PRINT A MESSAGE FOLLOWED BY A CR AND LF
*   
MESG CALL PRINT  PRINT THE MESSAGE DELIMITED BY 0.
 CALL CRLF  GO TO NEXT LINE.
 RET
*
*
*  PRINT - \SEND MESSAGE TO CONSOLE.
*
PRINT LDAX D  ADDRESS OF STRING IS IN DE.
 ORA A  CHECK FOR DELIMETER.
 RZ .  IF ZERO BYTE THEN DONE.
 CALL CONOUT  PRINT A CHAR.
 INX D  MOVE TO NEXT CHAR.
 JMP PRINT  LOOP UNTIL DONE.
*
*
*  CRLF
*
CRLF MVI A,CR  FIRST SEND A CR TO THE CONSOLE.
 CALL CONOUT
 MVI A,LF  THEN A LF.
 CALL CONOUT
 RET
*
*
*  ^ZERO - \ZEROES OUT PSCAN BUFFER; MEANS NO PASSWORD
*
ZERO MVI C,20  LENGTH OF BUFFER.
 XRA A  MAKE THE ZERO TO ZAP WITH.
 LXI D,PBUFF  WHERE THE ZEROES GO.
*
ZAPBUFF STAX D  ^ZAP!!!
 INX D  MOVE TO NEXT BYTE.
 DCR C  COUNT
 JNZ ZAPBUFF  UNTIL 0
 RET .  THEN RETURN.
*
*
*
*  HEXTOASCII
*
HEXTOASCII LHLD BUFFER  ASSUME NUMBER IS VALID IN BUFFER.
 MOV B,H  CONVERT HIGH BYTE.
 CALL ASC2
 MOV A,D  TAKE FROM DE AND STORE BACK IN BUFFER.
 STA BUFFER
 MOV A,E
 STA BUFFER+1
 MOV B,L  CONVERT LOW BYTE.
 CALL ASC2
 MOV A,D  PUT IN BUFFER ALSO.
 STA BUFFER+2
 MOV A,E
 STA BUFFER+3
 XRA A  FOLLOW WITH A ZERO
 STA BUFFER+4
 RET .  ALL DONE
*
*   
ASC2 MVI A,0F0H  MASK OFF LOW DIGIT.
 ANA B
 RRC .  SHIFT HIGH DIGIT DOWN TO LOW HALF OF BYTE.
 RRC
 RRC
 RRC
 CALL ASKEE  MAKE IT ASCII.
 MOV D,A  SAVE RESULT.
 MVI A,0FH  NOW SO LOW DIGIT.  MASK HIGH DIGIT OFF.
 ANA B
 CALL ASKEE  ASCII-IZE.
 MOV E,A  SAVE.
 RET
*
*
ASKEE CPI 0AH  FIND WHETHER DIGIT IS LETTER OR NUMBER.
 JNC LETTER
 ORI 30H  MAKE A NUMBER DIGIT ASCII.
 RET
*
LETTER ADI 'A'-0AH  MAKE A LETTER DIGIT ASCII.
 RET
*
*   
*
*  ASCIITOHEX
*
ASCIITOHEX LXI H,0  INITIALIZE SUM.
 LXI B,BUFFER  BC POINTS TO CURRENT INPUT DIGIT
*
ASCLOOP LDAX B  GET A DIGIT.
 ORA A  TEST FOR NUMBER DONE.
 JZ ASCDONE  YEP.
 CALL DEASCII  TURN CHARACTER INTO A NUMBER.
 RC .  CARRY RETURN MEANS ERROR.
 DAD H  ROTATE SUM LEFT 4 BITS.
 RC .  CARRY MEANS OVERFLOW OCCURED AND ERROR.
 DAD H
 RC
 DAD H
 RC 
 DAD H
 RC
 ORA L  MAKE A NEW LOW BYTE OF SUM
 MOV L,A  AND REPLACE IT
 INX B  GO TO NEXT CHARACTER IN NUMBER
 JMP ASCLOOP  AND GO BACK AND PROCESS IT.
*
ASCDONE SHLD BUFFER  PUT RESULT BACK IN BUFFER.
 XRA A  FOLLOW WITH 0 TO BE SAFE (ALSO RESET CARRY).
 STA BUFFER+2
 RET
*   
DEASCII SUI '0'  REMOVE ASCII BIAS AND CHECK FOR < '0'.
 RC .  BAD DIGIT.  CARRY SIGNALS ERROR.
 CPI 0AH  CHECK IF IT IS A LETTER DIGIT.
 CMC .  SO THAT CHECK CAN RETURN WITH CARRY CORRECT.
 RNC .  IT WAS A NUMBER DIGIT AND SO IS NOW OK.
 SUI 7  SUBTRACT OFFSET OF LETTERS FROM NUMBERS
 CPI 0FH+1  CHECK FOR DIGIT > F
 CMC .  GET CARRY RIGHT.
 RET .  IF CARRY SET THEN ILLEGAL DIGIT.
*
*
*
*  ASCDECTOHEX
*
ASCDECTOHEX LXI H,BUFFER  WHERE THE NUMBER IS.
 LXI D,PBUFF  SCRATCH BUFFER FOR PSCAN.
 MVI A,PSCN   CONVERT #, POINTED TO BY HL OF BASE B, INTO DE.
 MVI B,10  IT IS A DECIMAL NUMBER.
 CALL PSCAN  CONVERT!
 RC .  IF ERROR RETURN WITH CARRY SET.
 XCHG .  STORE NEW VALUE IN BUFFER.
 SHLD BUFFER
 RET .  WE KNOW CARRY IS NOT SET.
*   
*  Subroutine written by Mike Sherman
*   
*  DOUT writes the contents of HL to the COFILE as a decimal
*  number between -32768 and 32767 inclusive.  Leading zeroes
*  and + signs are not printed.
*       Calls DSUB to subtract DE from HL.
*       Calls PUTCHR for output to the COFILE.
*       All registers and flags are returned unchanged.
*   
DOUT PUSH PSW
 PUSH B
 PUSH D
 PUSH H
 MVI C,0  Flag means "don't print zeroes" initially.
 MOV A,H  Find out if we have a negative number.
 ORA A
 JP DOUT0  Nope.
 CMA  Set HL=-HL (two's complement)
 MOV H,A
 MOV A,L
 CMA
 MOV L,A
 INX H
 MVI A,'-'
 CALL PUTCHR  Print the minus sign.
*
DOUT0 LXI D,10000  First the 10000's digit gets printed.
 CALL DOUT1
 LXI D,1000  Then the 1000's.
 CALL DOUT1
 LXI D,100  The 100's.
 CALL DOUT1
 LXI D,10
 CALL DOUT1
 MOV A,L  Get the one's digit.
 ADI 48  Make it ascii.
 CALL PUTCHR  Print it.
 POP H
 POP D
 POP B
 POP PSW
 RET
*   
*                             Subroutine written by Mike Sherman
*   
*  This subroutine subtracts DE from HL as many times as it
*  will go before HL becomes negative.  Then DE is added back
*  on, and the number of times it went is printed unless it
*  was zero.  If DE is set to powers of any base<=10 then this
*  routine can be used to print a hex number in that base.
*  HL is left as it was just before it went negative.
*       A,B and HL are the only registers affected.
*   
DOUT1 MVI B,0  Count # of subtractions performed.
*
DOUT2 CALL DSUB  HL=HL-DE
 MOV A,H
 ORA A
 JM DOUT3  We're done if HL was negative.
 INR B
 JMP DOUT2
*
DOUT3 DAD D  Fix HL.
 MOV A,B  Get the digit.
 ORA C  If A is zero and we haven't printed anything else,
 RZ .  then don't print this zero.
 MOV A,B  Get the digit back again.
 ADI 48  Make it ascii.
 INR C  Remember that we printed something.
 CALL PUTCHR
 RET
*   
*                             Subroutine written by Mike Sherman
*   
*  DSUB is just like the DAD instruction except that it
*  subtracts DE from HL instead of adding it.  Only HL
*  is changed.  Flags are returned as they were.
*
DSUB PUSH PSW
 PUSH D
 MOV A,D  First set D=-D (two's complement).
 CMA
 MOV D,A
 MOV A,E
 CMA
 MOV E,A
 INX D
 DAD D  Add HL to -D.
 POP D
 POP PSW
 RET
*   
*   
*
*  PUTCHR
*   
PUTCHR PUSH PSW  DON'T CHANGE REGISTERS.
 PUSH B
 CALL CONOUT  PRINT CHAR TO CONSOLE.
 POP B  RESTORE REGISTERS.
 POP PSW
 RET
*   
*   
*   
*   
*  PTDER - \HANDLES PTDOS ERRORS
*   
PTDER STA ERMCD  STORE ERROR # FOR ERROR UTILITY.
 POP H  GET RETURN ADDRESS.
 DCX H  MOVE BACK TO COMMAND CODE.
 DCX H
 DCX H
 DCX H
 MOV A,M  GET ^CALL ^SYS OP.
 STA COMCD  STORE FOR ERROR UTILITY.
 PUSH H  PUT UPDATED RETURN ADDRESS BACK (NEVER RETURNED TO).
*
FINISH CALL SYSCLOSE  CLOSE ^SYSGLOBL.
 CALL TRAPRESET  PUT ERROR TRAPS BACK.
*
 IF DEBUG  THEN PRINT "CALLED FROM <ADDRESS>"
 POP H  RETURN ADDRESS.
 DCX H  MOVE TO ADDRESS OF CALL.
 DCX H
 DCX H
 MVI A,3  UTILITY OP.
 ENDF
*
 IF NOTDEBUG  PRINT "CALLED FROM CONFIG".
 LXI H,CONFIG  POINTER TO MESSAGE "CONFIG"
 MVI A,2  UTILITY OP; CALLED FROM AND HL -> STRING.
 ENDF
*
 CALL UTIL  EXPLAIN ERROR AND RETURN TO SYSTEM.
 DB UXOP
 JMP ABORT  ERROR RETURN (CAN'T HAPPEN).
COMCD DB -1  COMMAND OP
ERMCD DB -1  ERROR #
ABORT CALL SYS  NORMAL RETURN (CAN'T HAPPEN EITHER).
 DB ABTOP
*
CONFIG ASC "CONFIGR"
 DB 0
*
*
PSCER MOV A,E  TEST TYPE OF PSCAN ERROR.
 ORA A  CHECK FOR 0.
 JZ ARGERROR  IF FIELD ERROR FROM PSCAN...
 STA ERMCD  SAVE ERROR # FOR ERROR UTILITY.
 JMP FINISH  GO PROCESS ERROR.
*   
*
ARGERROR LXI D,AERRMESG  ARGUMENT ERROR MESSAGE.
 JMP RSET  PRINT IT AND RETURN.
AERRMESG ASC "Argument error"
 DB 0
*
BADPASSW LXI D,WRONGMESG  PASSWORDS DON'T MATCH.
 JMP RSET
WRONGMESG ASC "Incorrect password"
 DB 0
*
*
RSET CALL MESG  PRINT ERROR MESSAGE.
 CALL SYSCLOSE  CLOSE ^SYSGLOBL.
 CALL TRAPRESET  PUT ERROR TRAPS BACK.
 CALL SYS  RETURN TO SYSTEM, RESETTING.
 DB RESOP
*
*
ERROR LXI D,ERRMESG  PRINT "ERROR"AND RETURN
 CALL MESG
 RET
ERRMESG ASC " Error"
 DB 0
*   
*
*
*
TRAPSAVE LXI D,GLERS  SAVE SOFT ERROR TRAP
 CALL SYSGET  GET TRAP FROM GLOBAL AREA INTO HL
 SHLD STRAP
 LXI D,GLERM  SAVE MEDIUM ERROR TRAP
 CALL SYSGET
 SHLD MTRAP
 RET
*
TRAPINIT LXI D,GLERS  INITIALIZE SOFT ERROR TRAP
 LXI H,-1  TO RETURN TO CALLER
 CALL SYSPUT
 LXI D,GLERM  INIT MEDIUM ERROR TRAP
 LXI H,-1  TO RETURN
 CALL SYSPUT
 RET
*
TRAPRESET LXI D,GLERS  RESTORE SOFT ERROR TRAP
 LHLD STRAP
 CALL SYSPUT
 LXI D,GLERM  RESTORE MEDIUM ERROR TRAP
 LHLD MTRAP
 CALL SYSPUT
 RET
*
*
SYSGET LHLD SYSGLO  GET 16-BIT VALUE FROM GLOBAL AREA
 DAD D  OFFSET IS IN DE
 MOV A,M  GET LOW BYTE
 INX H
 MOV H,M  GET HIGH BYTE
 MOV L,A  VALUE ENDS UP IN HL
 RET
*
SYSPUT PUSH H  PUT 16-BIT VALUE INTO GLOBAL AREA
 LHLD SYSGLO
 DAD D
 POP D
 MOV M,E
 INX H
 MOV M,D
 RET
*
*   
*
*
*  STORAGE AREA
*
FILENUM DB 0FFH  ^SYSGLOBL FILE NUMBER (WHEN OPEN).
 DS 100  STACK AREA
STKEND EQU $  END OF STACK (TO INITIALIZE STACK POINTER).
PBUFF DS 20  BUFFER FOR USE BY PSCAN.
BUFFER DW 0  HOLDS INPUT FROM USER AND DATA FROM ^SYSGLOBL.
 DW 0
 DW 0
 DW 0
 DW 0
 DW 0
MTRAP DS 2  HOLDS OLD VALUE OF MEDIUM ERROR TRAP.
STRAP DS 2         "            SOFT    "     .
MESGADDR DS 2  ADDRESS OF WHO I AM MESSAGE FOR SWITCHES.
SPACOUNT DS 2  LOCATION OF SWITCH IN SYSGLOBL.
*
*
 END