Retro1.org codex

DEFSUB
* /---   FILE TYPE = E
* /---   BLOCK      IDENT      00 000   75/05/29  20.21 
          IDENT  DEFSUB 
          TITLE  SUBROUTINES USED BY -DEFINE- OVERLAY 
* 
          CST 
* 
          EXT    ECSPRTY,KEYTYPE
* 
* 
* /---   BLOCK      DEFSUB     00 000   81/07/16  04.24 
          TITLE  DEFINE/SEGMENT/UNITS OVERLAY CALLS 
* 
* 
* 
          ENTRY  DEFREAD
 DEFREAD  SA1    LOCAL       IF LOCAL SET ACTIVE, PURGE IT
          ZR     X1,DFRD10   IF LOCAL SET NOT ACTIVE
* 
          MX6    0           CLEAR LOCAL FLAG 
          SA6    A1 
          EXEC   DEFOV,3     PURGE LOCAL SET FOR GLOBAL SET 
* 
          ENTRY  DFRD10 
 DFRD10   EXEC   DEFOV,0     NORMAL DEFINE INTERPRETATION 
* 
* 
* 
          ENTRY  SEGREAD
 SEGREAD  EXEC   SEGOV,0
* 
* 
* 
          ENTRY  UNSREAD
 UNSREAD  EXEC   SEGOV,1
* 
* 
* 
          ENTRY  SEGFLG 
 SEGFLG   BSS    1
* 
* 
* /---   BLOCK      GETNAME    00 000   80/03/23  06.41 
          TITLE  -GETNAME-
* 
* 
* 
*         -GETNAME-          BUILD DEFINE NAME
*         ON ENTRY  -  B1 = MAXIMUM NUMBER OF CHARACTERS
*         ON RETURN -  X6 = LEFT JUSTIFIED NAME 
*                      X1 = TERMINATOR CHARACTER
*                      X2 = TERMINATOR KEYTYPE
*                      B1 = CHARACTER COUNT 
*                      B2 = -1 IF COLON ENCOUNTERED 
*                            0 IF NORMAL DELIMITER
* 
          ENTRY  GETNAME
 GETNAM0  SX4    X4-70B      CHECK FOR PRECEDING SHIFT
          ZR     X4,GETNAM2  IF COLON OR DOUBLE QUOTE 
* 
 GETNAME  EQ     *
          SB2    B0          FLAG NO COLON ENCOUNTERED
          SB3    B1          GET LIMIT ON LENGTH OF NAME
          SA1    WORDPT      POINTER TO FIRST CHAR OF NAME
          BX7    X1 
          SB1    B0          CHARACTER COUNT
          SB2    54          INITIALIZE SHIFT COUNT 
          MX6    0           BUILD NAME IN X6 
          RJ     NXTCODE     GET FIRST CHAR OF NAME 
          PL     X2,GETNAM0  MAY NOT BE NUMBER OR OP
* 
 GETNAM1  RJ     NXTCODE     GET NEXT CHARACTER 
          PL     X3,GETNAM0  EXITWITH TERMINATOR IN X1
          LT     B3,B1,GNERR    ERROR IF TOO MANY CHARACTERS
          EQ     GETNAM1
* 
 NXTCODE  EQ     *
 NXTCD1   BX4    X1          SAVE LAST CHARACTER CODE 
          SA1    X7 
          SX7    X7+1 
          SA7    WORDPT      ADVANCE / UPDATE POINTER 
          SX2    X1-1R       CODE FOR SPACE 
          ZR     X2,NXTCD1   IGNORE SPACES
          SA2    X1+KEYTYPE 
          SX3    X2-1        SEE IF TERMINATOR (OP) 
          PL     X3,NXTCODE 
          SB1    B1+1        INCREASE CHAR COUNT
          LX0    X1,B2
          SB2    B2-6        DECREASE SHIFT COUNT 
          BX6    X6+X0       ADD TO WORD BUILDING 
          EQ     NXTCODE
* 
 GETNAM2  BX6    X6-X0       REMOVE SHIFT CODE
          SB1    B1-1        DECREMENT CHARACTER COUNT
          SB2    -1          FLAG COLON ENCOUNTERED 
          EQ     GETNAME
* 
* 
 GNERR    SB1    29          BAD NAME 
          SA1    =10LBAD NAME 
          BX7    X1 
          SA7    CERROR1     STORE MESSAGE
          SX7    11          CODE FOR DEFINE ERROR
          SA7    TFORMOK
          SA3    LOCAL
          ZR     X3,=XERR    IF NOT PROCESING LOCAL SET 
* 
          SA1    DSET 
          SA1    SETNAMS+X1  X1 = NAME OF CURRENT SET 
          SA2    KLOCAL      X2 = NAME OF LOCAL SET 
          IX3    X1-X2
          ZR     X2,=XERR    IF LOCAL SET PROCESSING OK 
* 
          MX6    0           NO LOCAL SET IN EFFECT 
* /---   BLOCK      GETNAME    00 000   80/03/23  06.41 
          SA6    A3          ZERO LOCAL FLAG
          EQ     =XERR
* 
          ENTRY  KLOCAL 
 KLOCAL   DATA   00141703011400000000B
* 
* /---   BLOCK      DEFSUB     00 000   77/01/13  14.27 
          TITLE  -SYMCHK- 
* 
* 
* 
*         -SYMCHK-
*         CHECK IF DEFINED NAME CONFLICTS WITH SYSTEM NAME
* 
          EXT    FCTLIST,LASTFCT,NKLIST,NKLEND,ERRCALL
* 
          ENTRY  SYMCHK 
 SYMCHK   EQ     *
          SA1    B1          GET DEFINED NAME 
          BX6    X1 
          SA6    LASTFCT     PLANT FOR END TEST 
          SA6    NKLEND 
          SA6    SYMMES1     PLANT FOR ERROR MESSAGE
          MX0    42 
          SB1    1
          SA1    FCTLIST-1   INITIALIZE READ REGISTER 
* 
 SYMLP1   SA1    A1+B1       PICK UP NEXT FUNCTION NAME 
          BX1    X1-X6       SEE IF NAMES MATCH 
          BX2    X0*X1
          NZ     X2,SYMLP1   JUMP IF NO MATCH 
          NG     X2,SYMLP1   CHECK FOR -0 
          SB2    A1 
          SB3    LASTFCT     SEE IF A MATCH WAS FOUND 
          LT     B2,B3,SYMDUP 
          SA2    LASTFCT     GET DEFINED NAME AGAIN 
          SA1    NKLIST-1 
* 
 SYMLP2   SA1    A1+B1       GET NEXT ENTRY 
          BX6    X1-X2       COMPARE
          BX6    X0*X6       MASK FOR NAME
          NZ     X6,SYMLP2
          SB1    NKLEND      CHECK FOR NO MATCH 
          SB1    A1-B1
          NZ     B1,SYMDUP
          SA1    NLIST-1     INITIALIZE READ REGISTER 
* 
 SYMLP3   SA1    A1+1        LOAD NEXT NAME 
          ZR     X1,SYMCHK   EXIT IF END OF LIST
          BX1    X1-X2
          BX1    X0*X1
          NZ     X1,SYMLP3   JUMP IF DOES NOT MATCH 
* 
 SYMDUP   SB1    95          WARNING ERROR, SYSTEM VARIABLE RE-DEFINED
          RJ     =XRJERR
          EQ     SYMCHK 
* 
* 
*         EXTRA NAMES NOT RECOGNIZED AS FUNCTIONS, RESERVED 
*         WORDS OR KEY NAMES
* 
 NLIST    DATA   4LSKIP      DRAW  1010;SKIP;2010 
          DATA   0LBRANCH 
          DATA   0LDOTO 
+         VFD    12/7620B,48/0     PI 
+         VFD    12/7617B,48/0     DEGREE SIGN
          DATA   0
* 
 SYMMES1  DATA   0
* 
          END