
      HED SAVE
* THE SAVE COMMAND IS USED TO SAVE PROGRAMS IN THE USER LIBRARY.
* THE PROCEDURE IS AS FOLLOWS:
*     1) CHECK THAT PROGRAM IS LISTABLE (OR ID=A000), HAS A NAME, 
*        AND ISN'T NULL.
*     2) DECOMPILE. 
*     3) CHECK FOR IDT OR ADT OVERFLOW. 
*     4) CHECK FOR DUPLICATELY NAMED PROGRAM. 
*     5) UPDATE DIRECTORY.
*     6) UPDATE IDT AND ADT.
*     7) MOVE PROGRAM TO LIBRARY AREA.
* 
* STEP 5 IS WRITTEN AS AN OVERLAY, WHICH IS CALLED WHENEVER THE PAR-
* TICULAR DIRECTORY TRACK NEEDED IS ALREADY FULL. ITS JOB IS TO GAR-
* BAGE COLLECT THE DIRECTORY TRACKS.
      SPC 2 
      ORG LIBRA 
      SPC 1 
      LDB MLINK+1   B=>LINK WORD. 
      ADB .+?ID-?LINK  ID LOCN. 
      STB MOVES 
      ADB .+?PROG-?ID 
      STB SAVP
      ADB .+?DISC-?PROG 
      STB SAVD
      DLD MOVES,I   A=ID,B=1ST WORD OF NAME.
      SZB           TEST FOR NO PROGRAM NAME
      CPB ASCBB 
      JMP SAV3
      LDB SAVP,I    TEST FOR NULL PROGRAM.
      LDA .-11
      CPB PBUFF 
      JMP SAV4
* 
* WELL, AT LEAST THE PROGRAM HAS A NAME. NOW MAKE SURE IT IS
* DECOMPILED
* 
      JSB RDPRG     READ PROGRAM TO CORE. 
      LDB SAVP      TEST FOR COMPILED.
      ADB .+?FLAG-?PROG 
      LDA 1,I 
      AND CFLAG 
SAV0  SZA,RSS 
      JMP SAV5      NOT COMPILED. 
      JMP SAV5-1    ROOM FOR CSAVE CODE 
      BSS 11
      JSB DCMPL     DECOMPILE IT. 
* 
* NEXT MAKE SURE 'COMMON' IS ALLOCATED IF NECESSARY 
* 
SAV5  LDB SPROG     COMMON
      CPB PBUFF       ALLOCATED?
      JSB ALCOM     NO--DO IT 
* 
* PUT THE PROGRAM IN USERS SWAP AREA SO SOME WORK CAN GET DONE
* 
      LDB PBPTR     RESET PROGRAM BOUND 
      STB SAVP,I      INTO TABLE
      CMB,INB       COMPUTE # 
      ADB USE         OF WORDS
      STB MWORD 
      LDA SAVD      GET DISC ADDRESS POINTER
      LDB USE       WRITE OUT TO
      JSB DISCZ,I     SWAP TRACK
      JMP PTZAP,I   BLEW IT - DUMP THIS DUDE
SAV50 JMP SAV51 
      BSS 19        ROOM FOR CSAVE CODE 
* 
* DETERMINE IF THIS USER HAS ENOUGH ALLOCATED SPACE AVAILABLE TO
* SAVE THE PROGRAM. 
* 
SAV51 LDB SAVP,I    COMPUTE 
      CMB,INB         PROGRAM 
      ADB SPROG         LENGTH
      STB SAVWD     SAVE IN 
      ASR 8           NEGATIVE WORDS AND
      CMB,INB           POSITIVE
      STB SAVLN           BLOCKS
      LDB SPROG     SAVE START-OF-
      STB SAVP        PROGRAM POINTER 
* 
      JSB GCID,I    GET USER IDT ENTRY
      ADB .+7       GET DISC USED TO DATE.
      LDA 1,I 
      ADA SAVLN     GET TOTAL AMOUNT TO 
      CMA,INA         USED AS A NEGATIVE QUANTITY 
      ADB .-1 
      CLE 
      ADA 1,I       COMPARE WITH ALLOTMENT. 
      SEZ 
      JMP SAV6      OK. 
      LDB *+3 
      LDA .-19
      JMP LIBER 
      DEF *+1 
      OCT 5114      LF-L
      ASC 9,IBRARY SPACE FULL 
* 
* SEARCH ADT FOR SPACE TO PUT THE PROGRAM.
* 
SAV6  EQU * 
      LDA .-8       SET COUNT OF POSSIBLE DISK ADTS 
      STA SAVDF 
SAVBA EQU * 
      LDA RKCYP     GET CYCLIC POINTER
      ADA .+3         AND ADVANCE 
      CPA EALNA         IT TO THE 
      LDA EALCA           NEXT ENTRY
      STA RKCYP             IN THE TABLE
      ADA .+ADTLN-ADTAT  => LENGTH WORD 
      STA SAVD
      LDA SAVD,I    IS THIS DISK AVAILABLE
      SZA,RSS       ZERO SEZ NO ADT TABLE 
      JMP SAVBF     SO WE ADVANCE TO NEXT DISK
      STA MWORD     OTHERWISE, SAVE LENGTH
      LDA RKCYP     => DISC ADDRESS 
      LDB LIBDI 
      JSB DISCZ,I   READ IT IN
      JSB SICKP,I   SORRY, IT'S STUCK ON THE DISC 
      CCB           COMPUTE THE 
      LDA SAVD,I      ENTRY 
      DIV .+3           COUNT 
      STA SAVC            AND SAVE
      LDB LIBD      => FIRST ENTRY
      ADB .+2       => LENGTH WORD
SAVBD EQU * 
      LDA B,I       TEST THIS ENTRY FOR BIG ENOUGH
      CMA,CLE 
      ADA SAVLN 
      SEZ,RSS       SKIP IF TOO SHORT 
      JMP SAV7      GOTCHA
      ADB .+3       ADVANCE TO NEXT ENTRY 
      ISZ SAVC      DECREMENT ENTRY COUNT 
      JMP SAVBD     PROCESS NEXT ENTRY
SAVBF EQU *         PROCESS NEXT TRACK
      ISZ SAVDF     TRIED ALL DISKS FOR ROOM? 
      JMP SAVBA     NO, TRY THE NEXT ONE
* 
SAV23 EQU * 
      LDA .-16
      LDB *+2       PRINT "SYSTEM OVERLOAD" 
      JMP LIBER 
      DEF *+1 
      OCT 5123      LF-S
      ASC 7,YSTEM OVERLOAD
* 
SAV12 LDA .-16
      LDB *+2       PRINT "DUPLICATE ENTRY" 
      JMP LIBER 
      DEF *+1 
      OCT 5104      LF-D
      ASC 7,UPLICATE ENTRY
* 
SAV7  EQU * 
      LDA SAVLN     SAVE
      CMA,INA         NEGATIVE NUMBER OF
      ADA B,I           SECTORS LEFT
      STA SAVDF 
      ADB .-2       SAVE LOCATION OF
      STB SAVC        DISK ADT ENTRY
      DLD B,I       GET DISK ADDRESS
      DST SAVDS     AND SAVE
* 
      LDA DLTEM     MOVE ID/NAME ENTRY TO 
      STA MOVED      LTEMP(0:3).
      LDB .-4 
      JSB MOVEW 
SAV10 JMP SAV11     ROOM FOR CSAVE CODE 
      BSS 2 
* 
* SEARCH THE DIRECTORY TO INSURE THE PROGRAM NAME DOES NOT ALREADY
* EXIST 
* 
SAV11 EQU * 
      JSB DLOKP,I   SEARCH FOR ENTRY
      JMP SAV12     ENTRY FOUND--ILLEGAL. 
* 
      LDB SAVI,I    IF TRACK IS FULL, GO DO 
      CPB M8184      OVERLAY SECTION. 
      JMP SAV98 
* 
* EVERYTHING IS FINE.  BUILD A NEW DIRECTORY ENTRY AND INSERT 
* 
      CMB           SET UP SOURCE FOR 
      ADB LIBD       MOVE.
      STB MOVES 
      ADB .+12      SET UP DESTINATION
      STB MOVED 
      CMB           COMPUTE LENGTH. 
      ADB .+24
      ADB SAVS
      JSB MOVEB 
* 
      LDA DLTEM     MOVE 5 WORDS IN FOR 
      STA MOVES      NEW ENTRY. 
      LDA SAVS
      ADA .+12
      STA MOVED 
      LDB .-4 
      JSB MOVEW 
      LDA SAVP      STORE START-OF- 
      STA MOVED,I     PROGRAM POINTER 
      JSB DATE      STORE DATE IN ALSO. 
      ISZ MOVED 
      STA MOVED,I   LAST REFERENCE DATE 
      ISZ MOVED 
      LDA DATIM     GET HOUR OF YEAR
      STA MOVED,I   LAST CHANGE DATE
      ISZ MOVED 
      CLA           ZERO
      STA MOVED,I     WORD 7
      ISZ MOVED 
      DLD SAVDS     GET DISK ADDRESS FOR
      DST MOVED,I   WORDS 8 AND 9 
      LDB MOVED 
      ADB .+3       => WORD 11
      LDA SAVWD     GET THE LENGTH WORD FOR 
      STA B,I         WORD 11 
* 
      LDA SAVI,I    ADJUST
      ADA .-12       DIRECTORY
      STA SAVI,I      LENGTH. 
      STA MWORD 
      LDA SAVI      WRITE DIRECTORY BACK OUT. 
      INA 
      STA MOVED 
      ADA .+4 
      LDB LIBD
      STB MOVES 
      JSB DISCZ,I   WRITE OUT 
      JSB DEADP,I   FORGET IT 
* 
      LDB .-4       RESET DIREC.
      JSB MOVEW 
* 
* NOW UPDATE THE USER'S AMOUNT OF DISC SPACE USED 
* 
SAV21 EQU * 
      JSB GCID,I    READ IN THE IDT 
      ADB .+7 
      LDA SAVLN     ADJUST AMOUNT 
      ADA B,I         OF DISK SPACE USED
      STA 1,I 
* 
      LDA IDTAD     GET DISC ADDRESS POINTER
      LDB LIBD        TO WRITE IDT BACK 
      JSB DISCZ,I       TO THE DISC 
      JSB DEADP,I   THIS SYSTEM HAS HAD IT
* 
* NEXT, UPDATE THE ADT
* 
      LDA SAVD,I    FETCH THE LENGTH OF THE 
      STA MWORD       ADT TRACK 
      LDA RKCYP     GET THE DISC ADDRESS POINTER
      LDB LIBDI       AND READ IN THE 
      JSB DISCZ,I       ADT TRACK AGAIN 
      JMP SAV30     CAN'T - MAKE IT DISAPPEAR 
* 
      LDB SAVDF 
      SZB           ADT ENTRY COMPLETELY USED?
      JMP SAVCF     NO, SHORTEN IT
* 
      LDB SAVC      YES, REMOVE IT
      STB MOVED 
      ADB .+3       SET UP POINTERS FOR MOVE
      STB MOVES 
      ADB MLIBD     CALCULATE THE NEEDED
      ADB MWORD       WORD COUNT
      JSB MOVEW 
* 
      LDA .+3       SHORTEN THE APPROPRIATE COUNTS
      LDB SAVD,I
      ADB A         SHORTEN THE TABLE ENTRY 
      STB SAVD,I
      ADA MWORD     AND THE DISC DRIVER COUNT 
      STA MWORD 
      JMP SAVCG 
* 
SAV30 CLB 
      CLA 
      STA SAVD,I    ZERO OUT ADT'S LENGTH 
      DST RKCYP,I     AND DISC ADDRESS WORDS
      JMP SAV31 
* 
SAVCF EQU * 
      DLD SAVC,I    MOVE UP THE DISK ADDRESS
      CLE 
      ADB SAVLN       BY SAVLN BLOCKS 
      SEZ           CHECK FOR OVERFLOW
      INA 
      DST SAVC,I
      LDB SAVC      AND UPDATE THE COUNT
      ADB .+2       => LENGTH WORD
      LDA SAVDF     GET SAVED LENGTH
      STA B,I       AND PLUG IN 
* 
SAVCG EQU * 
      LDA RKCYP     GET DISC ADDRESS POINTER
      LDB LIBD        AND WRITE THE DISK ADT
      JSB DISCZ,I       BACK TO THE DISC
      JMP SAV30     CAN'T - MAKE IT DISAPPEAR 
* 
* RETRIEVE THE USER'S PROGRAM FROM THE SWAP AREA & WRITE IT OUT TO
* THE SELECTED AREA ON DISC.
* 
SAV31 JSB RDPRG     READ USER PROGRAM AGAIN 
      LDA SAVWD     WRITE IT OUT. 
      STA MWORD       TO LIBRARY
SAV24 JMP SAV25     ROOM FOR CSAVE CODE 
      BSS 18
* 
SAV25 EQU * 
      LDA SAVDP 
      LDB SAVP
      JSB DISCZ,I   WRITE TO DISC 
      SZA,RSS       TRANSFER SUCCESSFUL?
      JMP LLEND 
* 
* IF THE TRANSFER TO DISC WAS UNSUCCESSFUL, INDICATE 'BADLY SAVED 
* PROGRAM' IN THE DIRECTORY ENTRY AND PRINT ERROR MESSAGE.
* 
      JSB DLOKP,I   NO, GO GET DIRECTORY ENTRY AGAIN
      RSS           FOUND IT
      HLT DEATH+35B NOT FOUND: TROUBLE
      LDB LTEMP+5   GET POINTER TO ENTRY
      ADB .+4       => END OF COMMON POINTER
      LDA B,I       SET BIT 15 TO 
      IOR BIT15       INDICATE BADLY SAVED
      STA B,I           PROGRAM 
      LDA LTEMP+4   WRITE OUT 
      ADA .+5         DIRECTORY TRACK 
      LDB LIBD
      JSB DISCZ,I 
      JSB SLVAG,I   CAN'T DO IT, TRY TO SALVAGE 
      LDA SM31
      LDB *+2 
      JMP LIBER     PRINT FAILURE 
      DEF *+1 
      OCT 5125      LF-U
      ASC 15,NSUCCESSFUL; KILL AND REPEAT.
SAV3  LDA .-16
SAV4  LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5116      LF-N
      ASC 7,O PROGRAM NAME
SAV98 EQU * 
      LDA SM507     SET UP
      STA MWORD       OVERLAY.
      LDA SAVOV 
      LDB #LIBI 
      JMP SAV99 
EALCA DEF ADTAT 
EALNA DEF DKTBL 
SAVOV DEF COM6+SAVO-COM3+SAVO-COM3
SAVDP DEF SAVDS     => DISK ADDRESS 
SM507 DEC -507
SM31  DEC -31 
* 
SAVI EQU LTEMP+4    => DIREC ENTRY OF TRACK IN CORE 
SAVS EQU LTEMP+5    => DIRECTORY ENTRY PRECEEDING 
*                                     SPACE FOR NEW ENTRY 
SAVDS EQU LTEMP+6   DISC
*                         LTEMP+7     ADDRESS 
SAVWD EQU LTEMP+8   LENGTH IN WORDS OF PROGRAM
SAVC  EQU LTEMP+9   NUMBER OF ENTRIES IN ADT (NEG)
*                                   & POINTER TO DISC ADDRESS OF 1ST
*                                   AVAILABLE LOCATION FOR STORAGE
SAVP  EQU LTEMP+10  START-OF-PROGRAM POINTER
SAVD  EQU LTEMP+11  DISC ADDRESS POINTER
SAVDF EQU LTEMP+12
* 
* LTEMP, LTEMP+1, LTEMP+2, AND LTEMP+3 ARE ALSO USED HERE 
* 
SAVLN EQU T35CQ     LENGTH IN BLOCKS OF PROGRAM 
* 
* 
      ORG LIBRA+507 
SAV99 EQU * 
      JSB DISCZ,I 
      HLT 77B 
      JMP LIBRA 
      JMP SAV21     NORMAL RETURN 
      JMP SAV23     ERROR RETURN
$SAV  EQU * 
      HED CSAVE 
* THE CSAVE COMMAND IS USED TO SAVE PROGRAMS IN THE USER LIBRARY
* IN SEMI-COMPILED FORM. CSAVE BORROWS CODE FROM SAVE AND MUST
* FOLLOW IT.
* 
      ORG LIBRA 
      LDB MLINK+1 
* 
      ORG SAV0
      SZA           COMPILED? 
      JMP CSAV1     YES 
      LDB SPROG     NO, COMMON
      CPB PBUFF       ALLOCATED?
      JSB ALCOM     NO--DO IT 
      LDB SPROG     SET PROGRAM 
      STB PRGCT       COUNTER 
      LDA .+40B     TURN ON 
      STA BLANK       BLANK SUPPRESSION 
      CLA           CLEAR OUT-OF
      STA OFLAG       STORAGE FLAG               [B]
      JMP *+1,I     GO COMPILE IT 
      DEF CMP00 
CSAV1 LDA SPTR
      SZA           SEMI-COMPILED?
      JSB RSTPT     RESTORE SYMBOL TABLE POINTERS 
CSAV2 CLA           FLAG AS 
      STA SPTR        SEMI-COMPILED 
      LDB FILTB 
* 
      ORG SAV50 
      LDB FILTB 
      ADB .+7 
      CMB,INB 
      ADB LWAUS 
      SSB,RSS       TOO BIG?
      JMP CSAV4     NO
      LDA .-18      YES 
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5120      LF-P
      ASC 8,ROGRAM TOO LARGE
CSAV4 EQU * 
      LDB FILTB 
      ADB .+7 
* 
      ORG SAV10 
      LDA LTEMP+3   FLAG NAME 
      IOR BIT15       TO INDICATE 
      STA LTEMP+3       SEMI-COMPILED 
* 
      ORG SAV24 
      LDA FILTB     => FIRST WORD AFTER SYMBOL TABLE
      LDB SYMTB     SAVE END-OF 
      STB 0,I         PROGRAM POINTER 
      INA 
      LDB FILCT     SAVE # OF 
      STB 0,I         <FILES STATEMENTS>
      LDB DFILT     SAVE
      STB FILPT 
      LDB .-4 
      STB SPTR        POINTERS
CSAV3 INA 
      LDB FILPT,I 
      STB 0,I           TO <FILES 
      ISZ FILPT 
      ISZ SPTR
      JMP CSAV3           STATEMENTS> 
      INA           SAVE
      LDB USESN       'USING
      STB 0,I           SEEN' FLAG
* 
* THIS ROUTINE USES ALL LTEMPS USED IN 'SAVE' 
* 
