File: SHSAVE.PA of Disk: Disks/MyPDP/m8-blue-rka1-rkb1
(Source file text)
/SHSAVE.PA 1-NOV-79 /PROGRAM TO GENERATE SHORT SAVE FILES FOR STANDARD PROGRAMS /THE GENERATED PROGRAMS ACT LIKE A SORT OF CHAIN /TO THE PROGRAM OF THE SAME NAME ON DSK0: / /DEFINITIONS SHNDLR=7607 JFIELD=7744 JSTART=7745 JSBITS=7746 SOFSET=7747 MREAD=7757 MSWITC=7764 MSTCDF=7772 /IS 7773 IN OS/8 V40 BUT IS TAKEN CARE OF AT LOAD TIME MSTADR=7775 SBLOCK=7776 OSDATE=7666 / /WRITTEN BY ED SMALLENBURG / AUGUST 1975 /MODIFIED BY JAN VERBURG / SEPTEMBER 1975 /MAINTAINED BY ERNST LOPES CARDOZO / FEBRUARY 1979 /ADAPTED BY WILLEM VAN DER MARK / NOVEMBER 1979 / /COMMAND DECODER OPTIONS: /FILENAMES CAN BE SPECIFIED (MAX 1 AS OUTPUT FILE, / AND 5 AS INPUT FILE, DEFAULT EXT. .SV) / /S STANDARD PROGRAMS / /P PAL8 PGMS / /B BASIC PGMS / /F FORTRAN 2 PGMS / /4 FORTRAN 4 PGMS / /A ALL ABOVE PROGRAMS / /L LIST (LIKE FOTP) / /Q QUERY (LIKE FOTP) / /N DON'T GIVE A MESSAGE IF NOT FOUND / GERMAN=1 *20 DEVNO, 0 /DSK0 DEV # OPTAL, 0 /OPTIONS A-L OPTMX, 0 /OPTIONS M-X OPTY9, 0 /OPTIONS Y-9 POINT, 0 /POINTER TO LISTS HNDLR, 0 /HANDLER ENTRY POINT FOR DSK0: CNT1, 0 /TEMPORARY COUNTERS CNT2, 0 TODAY, 0 /REMEMBERS THE CURRENT DATE NAMES, ZBLOCK 6^4 0 /END OF NAMES *200 START, SKP CLA /STARTING ADDRESS CLA IAC /CHAIN ENTRY POINT 6254 /SKIP ON MULTI8 JMP I [ERROR0 /ONLY IN THE BACKGROUND SZA CLA JMP NOCD /MUST BE CHAIN CALLCD, CIF 10 JMS 200 5 /CALL CD 5200 /SPECIAL MODE TO ALLOW 5 NAMES NOCD, DCA ARG2 CDF 10 TAD I [OSDATE DCA TODAY /SAVE CURRENT DATE CDF 0 CIF 10 JMS 200 12 /INQUIRE ARG1, 6003 /DEVICE DSK0 ARG2, 0 /BECOMES DEVICE NR. ARG3, 0 /BECOMES ENTRY JMP I [ERROR1 /DEVICE NOT IN CORE TAD ARG3 DCA I [HANDLER+OFSET /SET ENTRY TAD ARG3 DCA HNDLR TAD ARG2 DCA I [SHDEV+OFSET /SET DSK0: DEV # TAD ARG2 /DEVICE NUMBER DCA DEVNO CDF 10 TAD I [7643 /OPTIONS A-L DCA OPTAL TAD I [7644 DCA OPTMX TAD I [7645 DCA OPTY9 CDF 0 TAD OPTMX AND [200 /OPTION Q ? SZA CLA JMP YOPTQ /Y TAD OPTAL /N RAR SZL CLA /OPTION L ? TAD I [OPTL /Y DCA I [OPTQ YOPTQ, TAD OPTMX RAL SMA CLA /OPTION N ? JMP .+3 TAD [R2&177+5200/JMP R2 DCA I [OPTN TAD OPTAL /OPTION A ? SMA CLA JMP EXE /NO CLA CMA /Y DCA OPTAL /SET ALL OPTIONS CLA CMA DCA OPTMX CLA CMA DCA OPTY9 EXE, TAD [DCA NAMES-1/FIRST WE DO THE FILES, WHICH ARE DCA DCANAM /MENTIONED AS INPUT FILES. TAD [-6 /THAT IS, WE HAVE TO GET THEM IN DCA CNT1 /THIS FIELD, ELIMINATING THE DEVICE- TAD [7600 /WORD IN BETWEEN. DCA 10 /USE AUTOINDEX CDF 10 NAMLP, TAD [-4 DCA CNT2 DCALP, ISZ DCANAM TAD I 10 /DATAFIELD IS 10 DCANAM, DCA NAMES /DIRECT, NO WORRY ABOUT FIELD ISZ CNT2 JMP DCALP /LOOP TAD DCANAM DCA DCANA1 TAD DCANAM TAD [TAD-DCA DCA .+1 HLT /TAD NAMES+3 SNA TAD [2326 /SV DCANA1, HLT /DCA NAMES+3 ISZ 10 ISZ CNT1 JMP NAMLP /LOOP CDF 0 JMP I (LISTHM PAGE LISTHM, TAD NAMES SNA CLA /OUTPUT FILENAME ? TAD [4 /NO, MAYBE INPUT TAD [NAMES JMS I [EXE2 /DO THE NAMES, IF NO NAMES NOTHING TAD OPTMX AND [40 //S SZA CLA TAD [SLIST JMS I [EXE2 /DO STANDARD PROGRAMS TAD OPTMX AND [400 //P SZA CLA TAD [PLIST JMS I [EXE2 TAD OPTAL RTL //B SZL CLA TAD [BLIST JMS I [EXE2 TAD OPTAL AND [100 //F SZA CLA TAD [F2LIST JMS I [EXE2 TAD OPTY9 AND [40 //4 SZA CLA TAD [F4LIST JMS I [EXE2 CLA IAC AND OPTMX SZA CLA TAD [XLST JMS I [EXE2 //X CDF 10 TAD I [7642 CDF 0 SMA CLA /ALTMODE SET ? JMP I (CALLCD /NO JMP I [X7600 /READY PAGE EXE2, HLT /SETUP FILES SNA JMP I EXE2 /NO FILES EXE2L, DCA POINT /SET POINTER TAD I POINT /MORE FILES ? SNA CLA /Y JMP I EXE2 /N JMS I [NOBTCH /GUARD AGAINST BATCH.SV OPTQ, JMS QUERY /ASK YES OR NO SKP /Y RETURN JMP R2 /NO RETURN JMS LOOKUP /LOOKUP FILE JMS WRITE /WRITE AWAY R2, TAD [4 /UPDATE POINTER TAD POINT JMP EXE2L /NEXT FILE QUERY, HLT /ASK Y OR N JMS I [PRNAM /PRINT NAME TAD ["? JMS I [TYP JMS I [LISN DCA T1 JMS I [CRLF TAD T1 TAD [-"Y SZA CLA ISZ QUERY JMP I QUERY /RETURN OPTL, JMS LIST /PRINT NAME LIST, HLT /WILL REPLACE QUERY, IF /L JMS I [PRNAM JMS I [CRLF JMP I LIST LOOKUP, HLT /LOOKUP FILE TAD POINT DCA NAM TAD DEVNO CIF 10 JMS I [200 2 /LOOKUP NAM, 0 0 /LENGTH OPTN, JMP I [ERROR2 /NOT FOUND TAD NAM DCA I [MCHREC+OFSET /SET BLOCK# OF CCBLOCK CDF 10 TAD I [1404 SNA /ANY DATE WORD IN DIRECTORY ? JMP NODATE /NO TAD I [0017 DCA NAM1 /USE AS TEMP POINTER TAD I NAM1 /GET DATE FROM DIRECTORY NODATE, DCA I [OSDATE /AND MAKE IT TODAY FOR A WHILE CDF 0 TAD NAM DCA NAM1 JMS I HNDLR /READ CORE CONTROL BLOCK OF 300 /TRUE FILE INTO CORE, SO LOA- CCCBUF /DING IS EASIER IN RUN-TIME. NAM1, 0 /ALSO READ FIRST WORD OF FILE JMP I [ERROR6 /INPUT ERROR, MUST BE SERIOUS CLL TAD I [CCCBUF CMA /TEST # OF ENTRIES IN .SV-FILE AND (7740 SZA CLA JMP I [ERROR7 /TOO MUCH TAD I [CCCBUF+5 AND [70 TAD [CDF DCA I [MTEST+OFSET /BUILD IN TEST TO CHECK FILE TAD I [CCCBUF+400 /CHECK WORD CIA DCA I [MCHECK+OFSET /READY FOR COMPARE JMP I LOOKUP WRITE, HLT /WRITE THE FILE TAD (CONTNT+600-1 DCA 10 /MOVE SHSAVE OVER CC BUFFER TAD (SHSAVE-1 DCA 11 TAD (-200 DCA CNT1 TRLOOP, TAD I 11 DCA I 10 ISZ CNT1 JMP TRLOOP TAD POINT DCA NAM2 TAD [41 /2 BLOCKS ON SYS: CIF 10 JMS I [200 3 /ENTER NAM2, 0 /BECOMES STBL 0 JMP I [ERROR3 /NO ROOM TAD NAM2 DCA SBL /SET BLOCK JMS I [SHNDLR 4400 /4 PAGES FIELD 0 CONTNT SBL, 0 JMP I [ERROR4 /OUTPUT ERROR TAD POINT DCA NAM3 CLA IAC CIF 10 JMS I [200 4 /CLOSE NAM3, 0 2 /2 BLOCKS JMP I [ERROR5 /CLOSE ERROR JMP I WRITE /RETURN X7600, CDF 10 CLA TAD TODAY DCA I [OSDATE CDF 0 JMP I [7600 T1, 0 PAGE CRLF, HLT TAD [215 JMS TYP TAD [212 JMS TYP JMP I CRLF TYP, HLT TLS CLA TSF JMP .-1 JMP I TYP LISN, HLT KSF JMP .-1 KRB AND (177 TAD (200 DCA T2 TAD T2 JMS TYP TAD T2 TAD [-203 /CTRL/C ? SNA CLA JMP I [X7600 TAD T2 JMP I LISN T2, PRNAM, HLT /PRINT NAME TAD POINT DCA T4 JMS PR2 JMS PR2 JMS PR2 TAD [". JMS TYP JMS PR2 JMP I PRNAM /RETURN PR2, HLT TAD I T4 RTR RTR RTR JMS PR3 TAD I T4 JMS PR3 ISZ T4 JMP I PR2 PR3, HLT AND [77 SZA TAD [240 AND [77 TAD [240 JMS TYP JMP I PR3 T4, PRSTR, HLT TAD I PRSTR SNA CLA JMP I PRSTR JMS PR2 JMP PRSTR+1 NOBTCH, 0 /CHECK THAT FILE IS NOT BATCH.SV CLA CMA TAD POINT DCA 10 TAD I 10 TAD [-0201 SNA TAD I 10 TAD [-2403 SNA TAD I 10 TAD [-1000 SZA CLA /DID HE TRY IT ? JMP I NOBTCH /NO, GOOD GUY ERROR8, JMS I [PRNAM JMS I [PRSTR /YES ! BAD GUY IFNDEF GERMAN < TEXT / SHORT-SAVE FORBIDDEN !/ > IFDEF GERMAN < TEXT / SHORT-SAVE VERBOTEN !/ > 0 JMP I [ERCRLF PAGE SLIST, FILENA FOTP.SV /STANDARD PROGRAMS FILENA TECO.SV FILENA DIRECT.SV FILENA EDIT.SV FILENA PIP.SV FILENA SRCCOM.SV FILENA RESORC.SV FILENA CAMP.SV FILENA FUTIL.SV FILENA HELP.SV FILENA SET.SV FILENA XCL.SV 0 /END OF LIST F2LIST, FILENA FORT.SV /FORTRAN 2 PROGRAMS FILENA SABR.SV FILENA LOADER.SV 0 F4LIST, FILENA F4.SV /FORTRAN 4 PROGRAMS FILENA RALF.SV FILENA LOAD.SV FILENA FRTS.SV 0 BLIST, FILENA BRTS.SV /BASIC PROGRAMS FILENA BASIC.SV FILENA BCOMP.SV 0 PLIST, FILENA PAL8.SV /PAL8 PROGRAMS FILENA ABSLDR.SV FILENA CREF.SV FILENA BITMAP.SV 0 PAGE /THE NEXT LIST IS INTENDED TO CONTAIN THE INSTALLATION- /SPECIFIC PROGRAMS: THESE ARE INVOKED WITH THE '/X' OPTION. XLST, FILENAME DCP.SV FILENAME DPF.SV FILENAME ACID.SV FILENAME FRUN.SV FILENAME FCOMP.SV FILENAME FCODE.SV 0 PAGE CCBUF=7200 /WHERE PROGS CCBLK GETS LOADED CONTNT, RELOC 6600 7777 /1 SEGMENT 6203 /STARTING FIELD SAVESH /STARTING ADDRESS 6000 /JSW-BITS CCBUF /LOADING ADDRESS 0200 /2 PAGE FIELD O RELOC ERROR0, JMS I [PRSTR IFNDEF GERMAN < TEXT *ONLY IN MULTI-8* > IFDEF GERMAN < TEXT *NUR UNTER MULTI-8* > 0 JMP I [X7600 ERROR1, JMS I [PRSTR IFNDEF GERMAN < TEXT *DSK0: NOT RESIDENT* > IFDEF GERMAN < TEXT *DSK0: NICHT RESIDENT* > 0 JMP I [X7600 ERROR2, JMS I [PRNAM JMS I [PRSTR IFNDEF GERMAN < TEXT * NOT FOUND* > IFDEF GERMAN < TEXT * NICHT DA* > 0 JMP ERCRLF ERROR3, JMS I [PRSTR IFNDEF GERMAN < TEXT *NO ROOM, SKIPPING * > IFDEF GERMAN < TEXT *KEIN PLATZ AUF SYS: FUER * > 0 ERRNAM, JMS I [PRNAM ERCRLF, JMS I [CRLF JMP I [R2 ERROR4, JMS I [PRSTR IFNDEF GERMAN < TEXT *OUTPUT ERROR, SKIPPING * > IFDEF GERMAN < TEXT *SCHREIB-FEHLER BEI * > 0 JMP ERRNAM ERROR5, JMS I [PRSTR IFNDEF GERMAN < TEXT *CLOSE ERROR, SKIPPING * > IFDEF GERMAN < TEXT *EINTRAGUNGS-FEHLER BEI * > 0 JMP ERRNAM ERROR6, JMS I [PRSTR IFNDEF GERMAN < TEXT *ERROR READING * > IFDEF GERMAN < TEXT *LESE-FEHLER BEI * > 0 JMS I [PRNAM JMP I [X7600 ERROR7, JMS I [PRNAM JMS I [PRSTR IFNDEF GERMAN < TEXT * IS BAD SV FILE* > IFDEF GERMAN < TEXT * IST KEIN SV DATEI* > 0 JMP I [X7600 PAGE OFSET=.-7400 SHSAVE=. RELOC 7400 /THIS ROUTINE CHAINS TO THE PROGRAM ON DSK0: /THE BLOCKNUMBER IS AT MCHREC /IF THERE WAS A CHAIN TO THIS PROGRAM /THE PROGRAM WILL BE STARTED AT STARTING ADDR.+1 / SAVESH, SKP CLA /STARTING ADDRESS , SKIPS CLA IAC /CHAINED TO 6254 /SKIP ON MULTI8 JMP CHERR /ONLY IN THE BACKGROUND OF MULTI8 TAD I (CCBUF+2 /STARTING ADDRESS (+1 IF CHAINED) DCA I (MSTADR /TO PAGE 7600 TAD I (SBLOCK /IS IT VERSION 40? SZA / ISZ (MSTCDF /YES, MSTCDF IS AT 7773!! SZA CLA TAD SHDEV /IF V40, SET DSK0: DEV # DCA I (SBLOCK /FOR SYSTEM LOOKUPS TAD MCHREC /COPY CORE-CONTROL BLOCK # DCA I (SOFSET /FOR MACREL OVERLAYS ISZ MCHREC /INCREMENT TO FIRST FILE BLOCK TAD I (CCBUF+1 DCA I (JFIELD /STARTING FIELD (FOR .ST) TAD I (CCBUF+2 DCA I (JSTART /STARTING ADDRESS (IDEM) TAD I (CCBUF+3 /JSBITS DCA I (JSBITS TAD I (CCBUF+1 /XFER INFO FROM CONTROL BLOCK DCA I (MSTCDF TAD MCHFJM DCA I (MSWITC MCHN1, ISZ I SH7200 JMP MCHN2 /NOT THE LAST TRANSFER TAD I MCHT1 /THE LAST TRANSFER IS NOT DONE DCA I (MREAD+2 /HERE, BECAUSE IT COULD OVERLAY ISZ MCHT1 /THIS PAGE, AND WE WOULDN'T HAVE TAD I MCHT1 /THE OPPORTUNITY TO JUMP ANYWHERE DCA I (MREAD+1 /SO WE USE THE DEDICATED PIECE TAD MCHREC /OF PROGRAM FROM 07577 ON. DCA I (MREAD+3 TAD HANDLER /ADDRESS OF DSK0: HANDLER DCA I (MREAD-1 /ALSO HANDLER ADDRESS USED BY MACREL OVERLAYS JMP I (MREAD /THERE WE GO MCHN2, TAD I MCHT1 DCA MCHADR /SET COMMAND TO READ NEXT SEGMENT ISZ MCHT1 TAD I MCHT1 DCA MCHCTL JMS I HANDLER MCHCTL, 0 /1 RECORD IN FLD 0 MCHADR, 0 MCHREC, 0 JMP CHERR /ERROR READING SEGMENT MTEST, HLT /CDF TO FIELD OF FIRST ENTRY TAD I MCHADR CDF 0 TAD MCHECK /TEST IF WORD IS STILL THE SAME SZA CLA JMP CHERR /NO, RUN SHSAVE AGAIN ! TAD CJMP DCA MTEST /ONCE ONLY CODING ! MCHBMP, TAD MCHCTL TAD M100 /CONVERT PAGES TO BLOCKS CLL RTL AND .+1 /AND (7000, BITS 7-11 ARE ZERO RTL RTL IAC /NOW # OF BLOCKS THIS TRANSFER IN AC TAD MCHREC DCA MCHREC ISZ MCHT1 JMP MCHN1 /LOOP ON NUMBER OF SEGM. MCHT1, CCBUF+4 MCHFJM, MSTCDF&177+5200 /"JMP MSTCDF" /OR "JMP MSTCDF-1" IN V40, I.E. JMP ON TCF. CHERR, SH7200, CLA TAD (1000 DCA I (JSBITS /SET NON-RESTARTABLE CHTADC, TAD CHARS SNA JMP I (7600 /GO TO MONITOR TLS TSF JMP .-1 /MAYBE WE'RE NOT IN THE BG. M100, 7700 /SMA CLA, DOES NOT SKIP ISZ CHTADC /NEXT CHAR JMP CHTADC CHARS, "?;"S;"H;"S;"A;"V;"E;"?;215;212;0 CJMP, JMP MCHBMP HANDLER,0 /DSK0 FAKE HANDLER ENTRY POINT SHDEV, 0 MCHECK, 0 PAGE RELOC CCCBUF=. IFNZRO CCCBUF-400-CONTNT <CCER, ___> FIELD 0 *200 $-$-$