File: QPIP.PA of Tape: Various/Decus/decus-1
(Source file text)
/COMMAND DECODER ALLOWING EXTRA CHARACTERS USR=JMS I [200 GO=JMP I [RESTRT OUTPUT=JMS I SROPT PRNT=JMS I [PRINTE *20 LINAD, 0 BACKSW, 0 /BACK ARROW SWITCH COUNT, 0 TEM1, 0 TEM2, 0 OPT, ZBLOCK 3 DEV, 0 /DEVICE NUMBER AS LOOKED UP SIZ, 0 /FILE SIZE IF SPECIFIED NAME, ZBLOCK 3 EXT, 0 /NAME AND EXTENSION ASSEMBLY AREA DOTSW, 0 COLNSW, 0 PCKNM, 0 /POINTER FOR PACKING NAME BUFFER DSKNUM, 0 DEFAUL, 0 SROPT, SRTCH /CURRENT "OUTPUT A CHAR" SUB DEVA, 0 /CURRENT DEVICE HANDLER ENTRY ALTF, 0 EQSW, 0 EQVAL, 0;0 EQCNT, 0 /OS/8 COMPATIBLE KEYBOARD INPUT ROUTINE *200 JMP I [START LININ, 0 /JMS LININ RETURNS POINTER TO ENTERED LINE CLA CLL CMA DCA CHAR TAD (B0+1 DCA POINT DCA I POINT ISZ CHAR LF, JMS I [LINE JMS PRINT KB0, B0 NXTCH, DCA F2 /SET OR CLEAR RUBOUT FLAG KSF JMP .-1 TAD (200 KRS DCA CHAR KCC TAD CHAR TAD (-377 SNA CLA IAC TAD F2 SNA CLA JMP .+3 TAD ("\ JMS SRTCH /TYPE ON CHANGE OF RUBOUT STATUS TAD CHAR JMS DISPAT LIST, /DISPATCH TABLE MONIT 203 /CONT/C LF K212, 212 /LINE FEED EXITA K215, 215 /C.R. EXITB 375 /ALT. MODE CONTU 225 /CONT/U RUB 377 /RUBOUT .+2 CHAR, 0 /ALWAYS MATCHES HERE TAD CHAR TAD (-340 CLL TAD (100 SNL CLA JMP NXTCH /IGNORE. WE DONT KNOW IT TAD CHAR JMS SRTCH /ECHO TAD CHAR DCA I POINT ISZ POINT DCA I POINT /MOVE UP TERMINATOR TAD POINT TAD (-B0TOP SZA CLA JMP NXTCH EXITA, JMS I [LINE EXITC, DCA ALTF TAD (B0+1 JMP I LININ /RETURN WITH POINTER IN AC. EXITB, TAD ("$ /ECHO FOR ALT. MODE JMS SRTCH CLA CMA JMP EXITC MONIT, JMS PRCON TSF JMP .-1 JMP 7600 CONTU, JMS PRCON JMP LININ+2 PRCON, 0 /PRINT CONTROL CHARS TAD ("^ JMS SRTCH TAD CHAR TAD (100 JMS SRTCH JMP I PRCON LINE, 0 /PRINT CR.,LF. TAD K215 OUTPUT TAD K212 OUTPUT JMP I LINE PRINT, 0 /PRINT TEXT FROM BUFFER TAD I PRINT ISZ PRINT DCA TEM NXP, TAD I TEM SNA JMP I PRINT OUTPUT ISZ TEM JMP NXP RUB, TAD POINT /RUBOUT CODE TAD (-B0-1 SNA /ARE WE BACK TO THE BEGINNING JMP LININ+2 /YES TAD KB0 DCA POINT TAD I POINT JMS SRTCH /PRINT ERASED CHAR DCA I POINT CLA CMA JMP NXTCH SRTCH, 0 /TYPE CHARACTER TSF JMP .-1 TLS CLA JMP I SRTCH POINT, 0 /BUFFER POINTER F2, 0 /RUBOUT FLAG TEM, 0 PAGE B0, "* ZBLOCK 110 B0TOP=. 0 B1, ZBLOCK 6^3 /3 OUTPUT FILES INFIL, ZBLOCK 6^3 /3 INPUT FILES B1TOP=. TOOMNY, TEXT /TOO MANY FILES/ SYNTX, TEXT /BAD SYNTAX/ ERSIZ, TEXT /FILE SIZE TOO LARGE/ ERRF, TEXT /SYSTEM ERROR/ FILER, TEXT / NOT FOUND/ ERRDF, TEXT /CANNOT RENAME ON DIFFERENT DEVICES/ WRITER, TEXT /HANDLER WRITE ERROR/ DOTCH, TEXT /./ ECLOSR, TEXT /CLOSE ERROR/ OPNER, TEXT /CANNOT CREATE FILE/ HEAD2, TEXT /DEVICE INFORMATION CURRENTLY IN SYSTEM TABLES/ HEAD3, TEXT /DEVICE NO. / HEAD4, TEXT /SYSTEM / DEVQ, TEXT / DOES NOT EXIST/ /ANALYSE A LINE OF TEXT /LIKE COMMAND DECODER BUT WIDER RANGE OF CHARACTERS PAGE LREAD, 0 /AC POINTS TO INPUT BUFFER DCA LINAD DCA OPT DCA OPT+1 DCA OPT+2 TAD [B1 DCA PCKNM /FILE NAME BUFFER DCA BACKSW /ENABLE BACKARROW TAD (B1-1 DCA 10 TAD (B1-B1TOP DCA TEM1 DCA I 10 /CLEAR OUTPUT BUFFER ISZ TEM1 JMP .-2 DCA EQSW TAD (-11 DCA EQCNT DCA EQVAL DCA EQVAL+1 CLRNM, TAD (DEV-1 DCA 10 TAD (-10 DCA TEM1 DCA I 10 ISZ TEM1 JMP .-2 NAMIN, TAD [NAME DCA PCKAD TAD (-4 DCA COUNT DCA SW RESET, TAD (JMS DISPAT DCA PRTCT /DISABLE CHARACTER PROTECTION CHRLP, TAD I LINAD SNA JMP END /ZERO MARKS END OF INPUT ISZ LINAD AND (77 DCA CHAR1 TAD CHAR1 PRTCT, JMS DISPAT /SWITCH FOR PROTECTION INAT 0 /START OF DISPATCH TABLE COLON 72 DOTC 56 BAKAR 74 BAKAR 37 COMMA 54 ROUNB 50 SQARB 33 SLASH 57 EQSGN 75 .+2 CHAR1, 0 /FORCED MATCH AT END TAD CHAR1 PCK, SNA JMP RESET /"@" CLOSES PROTECTION ISZ SW /WHICH BYTE JMP FIRST TAD I PCKAD DCA I PCKAD ISZ PCKAD JMP CHRLP INAT, TAD (JMP PCK /"@" STARTS PROTECTION JMP RESET+1 PCKAD, 0 SW, 0 DISPAT, 0 /DISPATCH ROUTINE CIA DCA TEM1 CLA CMA TAD DISPAT DCA 10 DISLP, TAD I 10 DCA TEM2 TAD I 10 TAD TEM1 SNA CLA JMP I TEM2 JMP DISLP FIRST, CLL RTL RTL RTL DCA I PCKAD CMA DCA SW ISZ COUNT /BAD SYNTAX ON SKIP JMP CHRLP BADS, CLA CLL PRNT /BAD SYNTAX SYNTX JMP ERREX END, JMS MOVUP ISZ BACKSW JMS MOVEM ISZ LREAD JMP I LREAD BADD, PRNT NAME PRNT DEVQ ERREX, JMS I [LINE JMP I LREAD /SKIP ON NO ERROR PAGE SLASH, JMS OPSET JMP CHRLP ROUNB, TAD I LINAD TAD (-") SNA CLA JMP CLOSEB JMS OPSET JMP ROUNB CLOSEB, ISZ LINAD JMP CHRLP OPSET, 0 /SET AN OPTION SWITCH TAD (OPT DCA TEM2 TAD I LINAD AND (77 ISZ LINAD SNA JMP BADS TAD (-15 SPA JMP FOUND ISZ TEM2 TAD (-14 SPA JMP FOUND ISZ TEM2 TAD (-2 SPA JMP YZ TAD (-25 SPA JMP BADS /ILLEGAL OPTION YZ, TAD (-12 SMA JMP BADS /ILLEGAL OPTION FOUND, DCA TEM1 TAD I TEM2 CMA DCA I TEM2 CLA CMA CLL RAL ISZ TEM1 JMP .-2 AND I TEM2 CMA DCA I TEM2 JMP I OPSET COLON, ISZ COLNSW SKP CLA JMP BADS CLL CML RTL /+2 TAD COUNT SZA IAC SZA CLA JMP BADS /WRONG NO OF CHARS TAD NAME DCA DEVN TAD NAME+1 DCA DEVN+1 CIF 10 USR 12 /INQUIRE DEVN, 0 0 0 JMP BADD /BAD DEVICE TAD DEVN+1 DCA DEV DCA NAME DCA NAME+1 CMA DCA COLNSW JMP NAMIN COMMA, JMS MOVUP JMP CLRNM BAKAR, ISZ BACKSW SKP CLA JMP BADS /HAD ONE ALREADY JMS MOVUP CLA CMA DCA BACKSW TAD [INFIL CIA TAD PCKNM SMA SZA CLA JMP BADN /TOO MANY OUTPUT FILES TAD [INFIL DCA PCKNM JMP CLRNM DOTC, ISZ DOTSW SKP CLA JMP BADS TAD (3 TAD COUNT SPA CLA JMP BADS /NO NAME FOR EXT TAD (EXT DCA PCKAD CLL CMA RAL DCA COUNT CMA DCA DOTSW CMA DCA COLNSW JMP RESET-1 PAGE RESTRT, JMS LININ JMS LREAD /SKIP ON LINE ANALYSED AND OK JMP RESTRT JMP NEXP MOVEM, 0 /SHIFT FILES IF THEY ARE INPUT ONLY TAD PCKNM TAD (-B1-1 SPA JMP I MOVEM TAD [B1 DCA PCKNM TAD PCKNM TAD (INFIL-B1 DCA TEM2 TAD TEM2 TAD (-B1TOP SMA CLA JMP BADN TAD I PCKNM DCA I TEM2 DCA I PCKNM JMP MOVEM+1 PR6, 0 /AUXILIARY ROUTINE AND (77 SNA JMP I PRINT6 TAD (40 AND (77 TAD (240 OUTPUT JMP I PR6 SQARB, TAD I LINAD ISZ LINAD AND (77 TAD (-"]!7700 SNA JMP CHRLP /CLOSED BRACKETS TAD ("]-"9-1!7700 CLL TAD (12 SNL JMP BADS /ITS NOT A DECIMAL DIGIT DCA TEM1 TAD SIZ CLL RAL JMS CHL RAL JMS CHL TAD SIZ JMS CHL RAL JMS CHL /SIZE*10 TAD TEM1 JMS CHL DCA SIZ JMP SQARB CHL, 0 /CHECK ARITH OVERFLOW FOR SQARB SNL JMP I CHL CLA PRNT ERSIZ JMP ERREX MOVUP, 0 /STOW A FILE AWAY TAD PCKNM TAD (-B1TOP SMA CLA JMP BADN /OFF END OF FILE BUFFER TAD (DEV-1 DCA 10 TAD (-6 DCA TEM1 MOVLP, TAD I 10 DCA I PCKNM ISZ PCKNM ISZ TEM1 JMP MOVLP JMP I MOVUP BADN, PRNT TOOMNY JMP ERREX PRINT6, 0 /PRINT FROM PACKED 6 BIT TEXT TAD I PRINT6 ISZ PRINT6 DCA TEM1 PRLP, TAD I TEM1 RTR;RTR;RTR JMS PR6 TAD I TEM1 JMS PR6 ISZ TEM1 JMP PRLP PRINTE, 0 /PRINT ERROR MESSAGES TAD (SRTCH DCA SROPT /RESET OUTPUT DEVICE TAD I PRINTE ISZ PRINTE DCA .+2 JMS PRINT6 0 JMP I PRINTE PAGE START, CLA CLL TLS CDF 0 CIF 10 JMS 7700 10 TAD DSKDEV DCA DSKN TAD DSKDEV+1 DCA DSKN+1 DCA DSKNUM CIF 10 INITS, USR /LOOKUP DSK 12 DSKN, DEVICE DSK 0 JMP BADDSK TAD DSKN+1 DCA DSKNUM GO DSKDEV, DEVICE DSK BADDSK, PRNT /DSK NOT KNOWN DSKDEV PRNT DEVQ ERGO, JMS I [LINE GO NEXP, TAD OPT+1 AND (100 / R OPTION SZA CLA JMP RENAM TAD OPT AND (10 / I OPTION SZA CLA JMP INQIR TAD OPT AND (1000 / C OPTION SZA CLA JMP CREAT PIPQ, TAD OPT+1 AND (400 / P OPTION SNA CLA GO /FINISHED ALL VALID OPTIONS TAD PIPNM DCA NAME TAD PIPNM+1 DCA NAME+1 TAD PIPNM+2 DCA NAME+2 TAD PIPNM+3 DCA EXT CLA IAC /SYS=1 JMS LOOKUP TAD (7577 DCA 10 TAD (7600-7646 DCA TEM1 CDF 10 DCA I 10 /ZERO OUT CD AREA ISZ TEM1 JMP .-2 CDF 0 TAD NMI DCA PIPB CIF 10 USR 6 /CHAIN PIPB, 0 EQSGN, ISZ EQSW SKP CLA JMP BADS CMA DCA EQSW EQLP, TAD I LINAD TAD (-"8 CLL TAD (10 DCA TEM1 SNL CLA JMP CHRLP ISZ EQCNT SKP CLA JMP BADS ISZ LINAD TAD EQVAL CLL RTL RAL DCA EQVAL TAD EQVAL+1 RTL RAL DCA TEM2 TAD TEM2 RAL AND (7 TAD EQVAL DCA EQVAL TAD TEM2 AND (7770 TAD TEM1 DCA EQVAL+1 JMP EQLP PIPNM, FILENAME PIP.SV PAGE LOOKUP, 0 /FILE LOOKUP SUBROUTINE DCA TEM1 /SAVE DEVICE NUMBER TAD [NAME DCA NMI DCA NMI+1 TAD TEM1 JMS HANFET 7201 TAD TEM1 CIF 10 USR 2 /LOOKUP NMI, NAME 0 JMP ERRFIL JMP I LOOKUP HANFET, 0 /HANDLER FETCH SNA JMP BADDSK DCA HTEM TAD I HANFET ISZ HANFET DCA HANF TAD HTEM CIF 10 USR 1 HANF, 0 JMP ERRFAT /CANT BE NOT FOUND NOW ! TAD HANF DCA DEVA JMP I HANFET HTEM, 0 ERRFAT, PRNT /SYSTEM ERROR ERRF JMP 7600 ERRDIF, PRNT /RENAME ON DIFFERENT DEVICES ERRDF JMP ERGO RENAM, TAD [INFIL DCA NAMW TAD [B1 DCA TEM2 TAD DSKNUM DCA DEFAUL NAMLP, TAD I NAMW /GET DEVICE NO. SNA TAD DEFAUL DCA DEFAUL /THIS IS NEW DEFAULT TAD I TEM2 SNA JMP DEVOK /ASSUME SAME AS INPUT CIA TAD DEFAUL SZA CLA JMP ERRDIF DEVOK, ISZ NAMW ISZ NAMW /IGNORE SIZE TAD I NAMW SNA CLA JMP PIPQ /NO FILE SO MUST BE END TAD (NAME-1 DCA 10 TAD (-4 DCA COUNT TAD I NAMW DCA I 10 ISZ NAMW ISZ COUNT JMP .-4 TAD DEFAUL JMS LOOKUP /FIND FILE IN DIRECTORY CDF 10 /PICK UP USR POINTERS TAD I (1404 TAD I (17 TAD (-5 DCA 10 TAD I (7 CDF 0 AND (7 DCA SEGNO /READY FOR REWRITE ISZ TEM2 ISZ TEM2 TAD (-4 DCA COUNT REPNAM, TAD I TEM2 /MOVE IN NEW NAME CDF 10 DCA I 10 CDF 0 ISZ TEM2 ISZ COUNT JMP REPNAM JMS I DEVA /REWRITE DIRECTORY SEGMENT 4210 1400 SEGNO, 0 JMP ERRWRT /IS WRITE LOCK ON ? TAD NAMW TAD (-B1TOP SPA CLA JMP NAMLP JMP PIPQ /END OF FILES NAMW, 0 /POINTER TO FILE LIST ERRWRT, PRNT WRITER JMP ERGO PAGE CREAT, TAD [B1 /OPEN & CLOSE FILE AS SPECIFIED DCA OARG CREATL, CLA CLL CML RTL /+2 TAD OARG DCA TEM1 TAD I TEM1 SNA CLA JMP PIPQ /NO NAME TAD I OARG SNA TAD DSKNUM DCA DEV TAD DEV DCA I OARG TAD TEM1 DCA NAMP2 CMA TAD TEM1 DCA TEM1 TAD I TEM1 SNA JMP CLOS /NO NEED TO OPEN FOR SIZE=0 DCA SIZ JMS OPEN OARG, 0 CLA CMA TAD SIZ CLL TAD FLMAX SZL CLA JMP NOCREA TAD SIZ CLOS, DCA NAMP2+1 TAD DEV JMS HANFET 7201 TAD DEV CIF 10 USR 4 NAMP2, 0 0 JMP CLOSER /FAILED TO CLOSE FILE TAD OARG TAD (6 DCA OARG TAD OARG TAD (-INFIL SPA CLA JMP CREATL /NOT COME TO END OF LIST JMP PIPQ NOCREA, PRNT OPNER JMP ERGO CLOSER, PRNT ECLOSR JMP ERGO ERRFIL, TAD EXT /FILE NOT FOUND DCA DOTSW DCA COLNSW DCA EXT PRNT NAME TAD DOTSW SNA CLA JMP .+5 PRNT DOTCH PRNT DOTSW PRNT FILER JMP ERGO OPEN, 0 /FILE OPEN ROUTINE TAD I OPEN /TAKES TABLE ADDRESS AS ARG ISZ OPEN DCA TEM1 TAD I TEM1 ISZ TEM1 SNA TAD DSKNUM /DSK IS DEFAULT DCA DEV TAD DEV JMS HANFET 7201 TAD I TEM1 AND (7400 SNA CLA TAD I TEM1 ISZ TEM1 CLL RTL RTL TAD DEV DCA TEM2 TAD TEM1 DCA FLBOT DCA FLMAX TAD TEM2 CIF 10 USR 3 FLBOT, 0 FLMAX, 0 JMP NOCREA JMP I OPEN PAGE BAUTO=17 SWITV=JMP I CH3+1 OUCHAR, 0 /CHARACTER TO FILE SUBROUTINE CH3, SWITV FIRSTC SECNDC THIRDC FIRSTC, DCA CH1 ISZ CLEARF ISZ CH3 JMP I OUCHAR SECNDC, DCA CH2 ISZ CH3 JMP I OUCHAR THIRDC, DCA CH3 TAD CH3 RTL RTL AND (7400 TAD CH1 DCA I BAUTO TAD CH3 RAR RTR RTR AND (7400 TAD CH2 DCA I BAUTO TAD (SWITV DCA CH3 TAD BAUTO TAD (-OUBTOP+1 SZA CLA JMP I OUCHAR JMS WRITE BSIZE DCA CLEARF TAD (OUBUF-1 DCA BAUTO JMP I OUCHAR OUSET, 0 /OUTPUT FILE SET UP ROUTINE JMS OPEN B1 DCA CLEARF DCA FLSIZ TAD (SWITV DCA CH3 TAD (OUCHAR DCA SROPT TAD DEVA DCA OUHAN TAD (OUBUF-1 DCA BAUTO JMP I OUSET OUCLR, 0 /CLEAR OUTPUT BUFFER AND CLOSE OUTPUT FILE TAD (232 OUTPUT TAD CLEARF AND (177 SZA CLA JMP OUCLR+2 TAD (SRTCH DCA SROPT /RESET OUTPUT DEVICE TAD CLEARF SNA JMP SKPWRT CLL RAL DCA .+4 DCA I BAUTO DCA I BAUTO JMS WRITE 0 SKPWRT, TAD FLSIZ DCA CLSARG TAD DEV CIF 10 USR 4 B1+2 CLSARG, 0 JMP CLOSER JMP I OUCLR CLEARF, WRITE, 0 /WRITE BUFFER TO FILE TAD I WRITE /ARG IS SIZE CLL CML RAR /MAKE WRITE INST. DCA CH1 TAD FLSIZ TAD FLBOT DCA CH2 TAD I WRITE RTL RTL RAL AND (37 TAD FLSIZ DCA FLSIZ /SET FOR SIZE AFTER WRITE TAD FLSIZ CLL TAD FLMAX SZL CLA JMP WSIZER /NO ROOM FOR THIS WRITE TSF JMP .-1 /IN CASE DEVICE IS TTY JMS I OUHAN CH1, 0 OUBUF CH2, 0 JMP ERRWRT JMP I WRITE WSIZER, PRNT ERSIZ JMP ERGO FLSIZ, 0 OUHAN, 0 PAGE INQIR, JMS OUSET TAD (214 OUTPUT JMS I [LINE JMS PRINT6 HEAD1 JMS I [LINE JMS I [LINE JMS PRINT6 HEAD2 TAD [INFIL DCA DEVPT JMS I [LINE CLA CMA CDF 10 TAD I (37 CDF 0 DCA TBASE /INFORMATION TABLE BASE TAD ("1 DCA DEVNM DEVLP, JMS I [LINE TAD I DEVPT SNA JMP INQFIN DCA DEVC JMS PRINT6 HEAD3 TAD DEVNM OUTPUT JMS I [LINE JMS PRINT6 HEAD4 JMS PRINT6 HEAD3 TAD DEVC JMS PROCT JMS I [LINE TAD DEVC TAD TBASE DCA TEM1 TAD DEVC TAD (7757 DCA TEM2 TAD DEVC TAD (7646 DCA LINAD CDF 10 TAD I TEM1 /DEVICE INFORMATION DCA IWRD TAD I TEM2 /DEVICE CONTROL TABLE DCA CWRD TAD I LINAD /RESIDENCY TABLE DCA RWRD CDF 0 TAD IWRD SNA JMP SYSTYP /PERMANENTLY RESIDENT SMA CLA JMP .+3 JMS PRINT6 TWOPG /TWO PAGE HANDLER JMS PRINT6 HNDLR JMS PRINT6 SVBLK /ON BLOCK NO. TAD IWRD RTL RTL RTL AND (17 TAD (15 JMS PROCT JMS I [LINE JMS PRINT6 ENTRAT TAD IWRD AND (177 INCON, JMS PROCT JMS I [LINE JMS PRINT6 CWRDT TAD CWRD AND (7770 JMS PROCT JMS I [LINE ISZ DEVNM TAD DEVPT TAD (6 DCA DEVPT TAD DEVPT TAD (-B1TOP SPA CLA JMP DEVLP INQFIN, JMS I [LINE JMS OUCLR JMP PIPQ SYSTYP, JMS PRINT6 PERM JMS PRINT6 HNDLR JMS I [LINE JMS PRINT6 ENTRAT TAD RWRD JMP INCON DEVPT, 0 DEVNM, 0 DEVC, 0 IWRD, 0 CWRD, 0 RWRD, 0 TBASE, 0 PAGE PROCT, 0 /OCTAL OUTPUT ROUTINE DCA TEM1 TAD (-4 DCA COUNT TAD TEM1 RAL NUMLP, RAL RTL DCA TEM2 SNL CMA DCA DOTSW TAD TEM2 AND (7 TAD (260 JMS OUCHAR ISZ COUNT SKP JMP I PROCT TAD TEM2 CLL ISZ DOTSW CML JMP NUMLP TWOPG, TEXT /TWO PAGE / HNDLR, TEXT /HANDLER/ SVBLK, TEXT / SAVED ON BLOCK / ENTRAT, TEXT /ENTRY AT / CWRDT, TEXT /DEVICE CONTROL WORD / PERM, TEXT /PERMANENTLY RESIDENT / HEAD1, TEXT /QPIP DEVICE ENQUIRY BDM JUL.73/ PAGE OUBUF, BSIZE=1000 OUBTOP=OUBUF+BSIZE $$$$