*
*    ONCE ONLY CODE TO PREPARE BASIC FOR PRODUCTION
*
*
*  PRINT 'SAVE' MESSAGE
*
 ORG XEND+1
 XEQ ONCE
*   
ONCE EQU $
*   
*   SET BASIC'S STACK
*   
 LXI H,CMNDSP
 SHLD SPTR
 SPHL
*
*  INITIALIZE SOME OTHER STUFF
*   
 CALL CFF  INIT NUMBER PRINTING FORMAT
 CALL DFC
 MVI A,63  INIT LINE LENGTH
 STA LINLEN
*
*  PRINT INTRODUCTION
*
IT5 CALL CRLF
 CALL CRLF
*   
 LXI H,MES5  PRINT INTRO
 CALL PRNT
 CALL CRLF
 LXI H,MES6
 CALL PRNT
 CALL CRLF
 LXI H,MES7
 CALL PRNT
 CALL CRLF
 CALL CRLF
 CALL CRLF
 CALL CRLF
*   
 LXI H,MES8  SIZING MEMORY
 CALL PRNT
 CALL CRLF
*
*   SIZE UP MEMORY
*
ITZ LXI H,0000
 LXI H,HEX2
*
IT0 MOV B,M
 MVI A,252Q
 MOV M,A
 CMP M
 MOV M,B
 JNZ IT1
 INX H
 MOV A,H
 ORA L
 JNZ IT0
IT1 DCX H
 SHLD MEMAX
*
IT9 LXI H,MES4  FIRST PROT IS
 CALL PRNT
IT10 LHLD SYSGLO
 LXI D,GLLOW
 DAD D
 CALL LHLI  FIRST PROTECTED MEMORY ADDRESS TO HL
*
IT91 DCX H  CONVERT TO LAST USEABLE
 XCHG
 LHLD MEMAX
 CALL HDCMP  SMALLER OF MAX AND INPUT
 JC IT11
 XCHG
IT11 LXI D,XEND+4096-1  LOWEST USEABLE ADDRESS
 CALL HDCMP  HL > LOWEST?
 JC IT81
*
 SHLD MEMAX  LAST USEABLE MEMORY LOC
 SHLD MEMTOP
 CALL HEXPRNT
 CALL CRLF
*   
*   
*  DELETE MATS
*   
IT2 LXI H,MES2
 CALL PRNT
 CALL SUCK
 PUSH PSW
 CALL CRLF
 POP PSW
 CPI 'Y'
 JZ DELMAT
 CPI 'N'
 JZ IT4
 JMP IT2
*   
DELMAT LXI H,XMAT
 MVI M,CR
 INX H
 SHLD BOFA
 SHLD EOFA
 LXI H,NIERR
 SHLD VMAT
*   
*  DEL FUNS
*   
IT3 LXI H,MES3
 CALL PRNT
 CALL SUCK
 PUSH PSW
 CALL CRLF
 POP PSW
 CPI 'Y'
 JZ DELFUNS
 CPI 'N'
 JZ IT4
 JMP IT3
*   
DELFUNS LXI H,XFUNS
 MVI M,CR
 INX H
 SHLD EOFA
 SHLD BOFA
 LXI H,NIERR
 SHLD VFSIN
 SHLD VFCOS
 SHLD VFTAN
 SHLD VFATN
 SHLD VFLOG
 SHLD VFLG10
 SHLD VFEXP
 SHLD VFXPN
*   
IT4 LXI H,MES9
 CALL PRNT
 CALL SUCK
 PUSH PSW
 CALL CRLF
 POP PSW
 CPI 'P'
 JZ ITDO
 SUI 'I'
 JNZ IT4
 STA IXOPORT  SET TO ZERO
*   
ITDO JMP XIT  DO IT!
*   
*   
IT81 CALL CRLF
 LXI H,MES1
 CALL PRNT
 CALL CRLF
 JMP 0BCB0H
*   
*   
*  TEXT
*
MES1 ASC 'NOT ENOUGH MEMORY"'
MES2 ASC 'DELETE MATRIX OPERATIONS? (Y,N)"'
MES3 ASC 'DELETE EXTENDED FUNCTIONS? (Y,N)"'
MES4 ASC 'FIRST PROTECTED MEMORY ADDRESS (HEX) IS "'
MES5 ASC '                   DBASIC   1.1  (mod 1)"'
MES6 ASC '        Copyright 1977 by Processor Technology Corp."'
MES7 ASC '              ***   ALL RIGHTS RESERVED   ***"'
MES8 ASC 'SIZING MEMORY"'
MES9 ASC 'PTDOS OUTPUT OR INTERNAL VDM DRIVER? (P,I)"'
*
*  MISC SUBS
*
*    SUCK IN A CHARACTER
SUCK PUSH H
 CALL SYSIN
 POP H
 ANI 177Q
 MOV B,A
 CPI CR
 RZ 
*  ECHO IT
*   
 JMP SYSOT
*   
*
*  PRINT HEX NUMBER
*   
HEXPRNT MVI B,4
HEX1 PUSH B
 XRA A
 DAD H
 RAL .
 DAD H
 RAL .
 DAD H
 RAL .
 DAD H
 RAL .
 CPI 10
 JC HEX2
 ADI 'A'-'9'-1
HEX2 ADI '0'
 MOV B,A
 CALL SYSOT
 POP B
 DCR B
 JNZ HEX1
 RET
*   
*  PRINT SAVE MESSAGE
*
XIT CALL CRLF
 LXI H,LSTW1
 CALL PRNT
 LHLD EOFA
 CALL HEXPRINT
 LXI H,LSTW2
 CALL PRNT
 CALL CRLF
*   
*    DO A CHECKSUM FOR THE COPYRIGHT MESSAGE
*
 LXI H,CRM
 MVI B,CRML
 XRA A
ONCE1 ADC M
 INX H
 DCR B
 JNZ ONCE1
 STA CKSUM  SET CHECKSUM FOR COPYRIGHT MESSAGE
*
 CALL SYS  RETURN TO PTDOS
 DB RETOP
*
 IF M48K
LSTW1 ASC 'TYPE:  IMAGE BASIC,!9C0,100,"'
LSTW2 ASC ',100"'
 ENDF
 IF M60K
LSTW1 ASC 'TYPE:  IMAGE BASIC,!9C0,D040,FFFE,100,"'
LSTW2 ASC ',D040"'
 ENDF
*   
*